home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Varios Español
/
Varios Español.iso
/
CLIPP52
/
TCBLLIB1.ZIP
/
LLIBGTOO.PRG
< prev
next >
Wrap
Text File
|
1993-11-23
|
196KB
|
5,374 lines
#INCLUDE "llibg.ch" // Include definitions file for Light Lib Graphics
#INCLUDE "llibgtoo.ch" // Include definitions file for Light Lib Graphics tools
#INCLUDE "Inkey.ch"
#INCLUDE "Getexit.ch"
STATIC aPrompt := {} // Static array to handle MENU TO replacement
STATIC aBmpBase := {} // Static array to load majors .BMP in an INIT function
STATIC nPotRed := 0 // Red component of a color (Palette group)
STATIC nPotGre := 0 // Green component of a color (Palette group)
STATIC nPotBlu := 0 // Blue component of a color (Palette group)
MEMVAR GetList // Allow the use of public GetList variable
// without warnings
*
// Group Buttons
// Note : Here are some CA-CLIPPER
// functions to allow use of buttons
// with mouse and BMP
/***
*
* LoadBmpBase() Load the majors BMP when EXE start to avoid reloading
* aButtonAdd() Add a button to a list
* lButtonKill() Kill one or a list of buttons
* ButtonShowAll() Show a list of buttonss
* ButtonDisplay() Display one button
* XorButton() XOR a button
*
*
*/
*
#DEFINE ARROW_U_UP 1 // Arrow Up - Pos Up
#DEFINE ARROW_U_DW 2 // Arrow Up - Pos Dw
#DEFINE ARROW_D_UP 3 // Arrow Dw - Pos Up
#DEFINE ARROW_D_DW 4 // Arrow Dw - Pos Dw
#DEFINE ARROW_E_UP 5 // Arrow Empty - Pos Up
#DEFINE ARROW_E_DW 6 // Arrow Empty - Pos Dw
#DEFINE ARROW_L_UP 7 // Arrow Left - Pos Up
#DEFINE ARROW_L_DW 8 // Arrow Left - Pos Dw
#DEFINE ARROW_R_UP 9 // Arrow Right - Pos Up
#DEFINE ARROW_R_DW 10 // Arrow Right - Pos Dw
#DEFINE ARROW_G_UP 11 // Arrow Get Up/Dw- Pos Up
#DEFINE ARROW_G_DW 12 // Arrow Get Up/DW- Pos Dw
#DEFINE RADIO_E_UP 13 // Radio Get Empty- Pos Up
#DEFINE RADIO_E_DW 14 // Radio Get Empty- Pos Dw
#DEFINE RADIO_F_UP 15 // Radio Get Full - Pos Up
#DEFINE RADIO_F_DW 16 // Radio Get Full - Pos Dw
#DEFINE CHECK_E_UP 17 // Check Get Empty- Pos Up
#DEFINE CHECK_E_DW 18 // Check Get Empty- Pos Dw
#DEFINE CHECK_F_UP 19 // Check Get Full - Pos Up
#DEFINE CHECK_F_DW 20 // Check Get Full - Pos Dw
#DEFINE DROPBOX_UP 21 // DropBox Get - Pos Up
#DEFINE DROPBOX_DW 22 // DropBox Get - Pos Dw
#DEFINE CLOSWIN_UP 23 // Close Window - Pos Up
#DEFINE CLOSWIN_DW 24 // Close Window - Pos Dw
*
INIT FUNCTION LoadBmpBase()
// Load the majors BMP when EXE start to avoid reloading
aBmpBase := {}
// Arrow Up
AADD(aBmpBase,gBmpLoad( "ARROW_U.BMU" ))
AADD(aBmpBase,gBmpLoad( "ARROW_U.BMD" ))
// Arrow Down
AADD(aBmpBase,gBmpLoad( "ARROW_D.BMU" ))
AADD(aBmpBase,gBmpLoad( "ARROW_D.BMD" ))
// Arrow Empty
AADD(aBmpBase,gBmpLoad( "ARROW_E.BMU" ))
AADD(aBmpBase,gBmpLoad( "ARROW_E.BMD" ))
// Arrow Left
AADD(aBmpBase,gBmpLoad( "ARROW_L.BMU" ))
AADD(aBmpBase,gBmpLoad( "ARROW_L.BMD" ))
// Arrow Right
AADD(aBmpBase,gBmpLoad( "ARROW_R.BMU" ))
AADD(aBmpBase,gBmpLoad( "ARROW_R.BMD" ))
// Arrow Get Up/Dw
AADD(aBmpBase,gBmpLoad( "ARROW_G.BMU" ))
AADD(aBmpBase,gBmpLoad( "ARROW_G.BMD" ))
// Radio Get Empty
AADD(aBmpBase,gBmpLoad( "RADIO_E.BMU" ))
AADD(aBmpBase,gBmpLoad( "RADIO_E.BMD" ))
// Radio Get Full
AADD(aBmpBase,gBmpLoad( "RADIO_F.BMU" ))
AADD(aBmpBase,gBmpLoad( "RADIO_F.BMD" ))
// Check Get Empty
AADD(aBmpBase,gBmpLoad( "CHECK_E.BMU" ))
AADD(aBmpBase,gBmpLoad( "CHECK_E.BMD" ))
// Check Get Full
AADD(aBmpBase,gBmpLoad( "CHECK_F.BMU" ))
AADD(aBmpBase,gBmpLoad( "CHECK_F.BMD" ))
// Drop box Get
AADD(aBmpBase,gBmpLoad( "DROPBOX.BMU" ))
AADD(aBmpBase,gBmpLoad( "DROPBOX.BMD" ))
// Close window
AADD(aBmpBase,gBmpLoad( "CLOSEWIN.BMU" ))
AADD(aBmpBase,gBmpLoad( "CLOSEWIN.BMD" ))
RETURN (NIL)
*
FUNCTION aButtonAdd(nButLeft ,; // Left coord in pixels
nButTop ,; // Top coord in pixels
nButRight ,; // Right coord in pixels
nButBottom ,; // Bottom coord in pixels
nButType ,; // Button Type (From LLibgToo.CH)
xButAction ,; // Action (CodeBlock or Key value)
xButAccel ,; // Accelerator Key (INKEY() value or string value)
aButBmpUp ,; // Button representation in upper position (BMP,String,Block)
aButBmpDown ,; // Button representation in down position (BMP,String,Block)
aButCtrls ,; // Array to attach the button
xButCargo ; // Cargo value of the button
)
// Add a button to a list
IF nButRight == NIL
IF VALTYPE(aButBmpUp) == 'A'
// The button size is deducted from the BMP size
nButRight := nButLeft + aButBmpUp[LLG_BMP_X] - 1
ELSEIF VALTYPE(aButBmpUp) == 'C'
// The button size is deducted from the length
// of the string
nButRight := nButLeft + (LEN(aButBmpUp)+1)*FONT_SIZE_X - 1
ELSEIF VALTYPE(aButBmpUp) == 'B'
// The button size must be defined
ENDIF
ENDIF
IF nButBottom == NIL
IF VALTYPE(aButBmpUp) == 'A'
// The button size is deducted from the BMP size
nButBottom := nButTop + aButBmpUp[LLG_BMP_Y] - 1
ELSEIF VALTYPE(aButBmpUp) == 'C'
// The button size is deducted from font size
nButBottom := nButTop + FONT_SIZE_Y - 1
ELSEIF VALTYPE(aButBmpUp) == 'B'
// The button size must be defined
ENDIF
ENDIF
IF xButAccel==NIL // If Accelerator key is undefined, default
// to 0
xButAccel := 0
ELSEIF VALTYPE(xButAccel)=='C'
// If accelerator is defined as a string,
// transform into ASCII value
xButAccel := ASC(xButAccel)
ENDIF
IF aButBmpUp == NIL // If no button representation defined, default
// to a empty block
aButBmpUp := { || NIL }
ENDIF
IF aButBmpDown == NIL // If no representation of Down button defined,
// default to Up representation
aButBmpDown := aButBmpUp
ENDIF
// Add the button parameters to the handler
AADD(aButCtrls , { nButLeft ,;
nButTop ,;
nButRight ,;
nButBottom ,;
nButRight-nButLeft-1 ,;
nButBottom-nButTop-1 ,;
nButType ,;
xButAction ,;
aButBmpUp ,;
aButBmpDown ,;
xButAccel ,;
xButCargo ;
} ;
)
// Return the button parameters
RETURN (ATAIL(aButCtrls))
*
FUNCTION lButtonKill(aButCtrls ,; // List of related buttons
nKillColor ,; // Color to be used to clear
aButtonPtr ; // List of buttons to be cleared
)
// aButtonPtr == NIL --> Destroy all
// aButtonPtr == Ptr --> Destroy one
// aButtonPtr == Arr --> Destroy specified buttons
// Kill one or a list of buttons
LOCAL nI := 0
LOCAL nJ := 0
LOCAL nLen := LEN(aButCtrls)
LOCAL lKilled := .F.
IF aButtonPtr==NIL
// Destroy all
IF nKillColor <> NIL
FOR nI := 1 TO nLen
gRect(aButCtrls[nJ,BUTTON_LEFT] ,;
aButCtrls[nJ,BUTTON_TOP ] ,;
aButCtrls[nJ,BUTTON_RIGHT] ,;
aButCtrls[nJ,BUTTON_BOTTOM] ,;
LLG_FILL ,;
nKillColor ,;
LLG_MODE_SET ;
)
NEXT nI
ENDIF
aButCtrls := {}
RETURN( lKilled := .T. )
ELSEIF VALTYPE(aButtonPtr[1])<>'A'
// Convert to the common case
aButtonPtr := { aButtonPtr }
ENDIF
FOR nI := 1 TO LEN(aButtonPtr)
// Find the ptr in the button list
IF (nJ := ASCAN(aButCtrls, { |aPtr| aPtr == aButtonPtr[nI] })) > 0 .AND. nJ <= nLen
IF nKillColor <> NIL
// If needed, clear area
gRect(aButCtrls[nJ,BUTTON_LEFT] ,;
aButCtrls[nJ,BUTTON_TOP ] ,;
aButCtrls[nJ,BUTTON_RIGHT] ,;
aButCtrls[nJ,BUTTON_BOTTOM] ,;
LLG_FILL ,;
nKillColor ,;
LLG_MODE_SET ;
)
ENDIF
// Resize ptr list
nLen--
ASIZE(ADEL(aButCtrls,nJ),nLen)
lKilled := .T. // Button killed
ENDIF
NEXT nI
RETURN (lKilled)
*
FUNCTION ButtonShowAll(aButCtrls ,; // List of related buttons
aButtonPtr ; // List of buttons to be displayed
)
// aButtonPtr == NIL --> Display all
// aButtonPtr == Ptr --> Display one
// aButtonPtr == Arr --> Display specified buttons
// Show a list of buttonss
LOCAL nI := 0
LOCAL nJ := 0
LOCAL nLen := LEN(aButCtrls)
IF aButtonPtr==NIL
// If list of ptr is empty, display all
FOR nJ := 1 TO nLen
ButtonDisplay(aButCtrls[nJ],.T.)
NEXT nI
RETURN( NIL )
ELSEIF VALTYPE(aButtonPtr[1])<>'A'
// Convert to the common case
aButtonPtr := { aButtonPtr }
ENDIF
FOR nI := 1 TO LEN(aButtonPtr)
// Find ptr in the button list
IF (nJ := ASCAN(aButCtrls, { |aPtr| aPtr == aButtonPtr[nI] })) > 0 .AND. nJ <= nLen
// Display
ButtonDisplay(aButCtrls[nJ],.T.)
ENDIF
NEXT nI
RETURN (NIL)
*
FUNCTION ButtonDisplay(aButton ,; // Button to be displayed
lDisplayUp ; // Display on upper position
)
// Display one button in up or down position
// Retrieve button style
LOCAL cButtonStyle := VALTYPE(IF(lDisplayUp,aButton[BUTTON_ICO_UP],aButton[BUTTON_ICO_DOWN]))
IF cButtonStyle=='A'
// Assume it is a .BMP array
gBmpDisp( IF( lDisplayUp ,;
aButton[BUTTON_ICO_UP] ,;
aButton[BUTTON_ICO_DOWN] ;
) ,;
aButton[BUTTON_LEFT] ,;
aButton[BUTTON_TOP ] ,;
)
ELSEIF cButtonStyle=='C'
// It's a text button, display on one line
gFrame(aButton[BUTTON_LEFT] ,;
aButton[BUTTON_TOP ] ,;
aButton[BUTTON_RIGHT] ,;
aButton[BUTTON_BOTTOM] ,;
07 ,;
IF(lDisplayUp,00,15) ,;
IF(lDisplayUp,15,00) ,;
1, 1, 1, 1, LLG_MODE_SET ;
)
gWriteAt(aButton[BUTTON_LEFT]+(FONT_SIZE_X/2)+1 ,;
aButton[BUTTON_BOTTOM]-FONT_SIZE_Y+1 ,;
aButton[BUTTON_ICO_UP] ,;
0 ,;
LLG_MODE_SET ;
)
ELSEIF cButtonStyle=='B'
// It's a use defined button, eval to display
// pass button's coordinates to the code-block
EVAL(IF( lDisplayUp ,;
aButton[BUTTON_ICO_UP] ,;
aButton[BUTTON_ICO_DOWN] ;
) ,;
aButton[BUTTON_LEFT] ,;
aButton[BUTTON_TOP ] ,;
aButton[BUTTON_RIGHT] ,;
aButton[BUTTON_BOTTOM] ,;
aButton[BUTTON_CARGO] ;
)
ENDIF
RETURN (NIL)
*
FUNCTION XorButton(nLeft ,; // Left coord in pixels
nTop ,; // Top coord in pixels
nRight ,; // Right coord in pixels
nBottom ; // Bottom coord in pixels
)
// XOR a button
// Note : when your XOR and reXOR a button, you
// get the original display back
gRect(nLeft ,;
nTop ,;
nRight ,;
nBottom ,;
LLG_FILL ,;
15 ,;
LLG_MODE_XOR ;
)
RETURN (NIL)
*
// Group mInkey() / Buttons
// Note : Here are some CA-CLIPPER
// functions to allow use of buttons, mouse and
// Keyboard with mInkey()
/***
*
* mInkey() Replaceable INKEY() function
* nApplyMouse() Apply a mouse action to buttons lists
* nApplyKey() Apply a accelerator key to buttons lists
* nHitGet() Set/Get function to allow mousable gets
* lMouseInButton() Is the mouse inside a button
* aWhichButton() Find the button corresponding to mouse location
*
*/
*
FUNCTION mInkey(nSeconds ,; // Classical INKEY() parameter
aButCtrls ,; // Array of buttons defined with aButtonAdd()
aGetList ; // For use in GetSys.prg, to be able to track buttons OR Gets
)
// mInkey() function is a replacement function for
// INKEY() function. Passing aButCtrls parameter
// allow you to defined and manage buttons in a couple
// of seconds. When the user hit a button with the
// mouse, mInkey() manage all events associated.
// If the button's action is a code-block, mInkey()
// EVAL this code-block with 3 parameters, mouse X
// coordinate, mouse Y coordinate and button Ptr.
// nReturn take the K_BUTTON value and the function
// returns, which allows you to process button and
// keys in the same way. (see tbdemo.prg)
// If the user clic out of all the buttons from the
// list, mInkey() return K_CLIC_OUT
// If the user strike an accelerator key, the action
// is executed and the K_ACCELERATOR value is returned.
// When a get is hitted, the K_GET value is returned
LOCAL nReturn := 0 // Return value of mInkey() function
LOCAL lLeft := .F. // Left mouse button hitted
LOCAL lRight := .F. // Right mouse button hitted
LOCAL nTime := 0 // Time controler
LOCAL aMouseState := mState() // Mouse state array
IF aButCtrls==NIL // Default aButCtrls to an array
aButCtrls:={}
ENDIF
IF aGetList==NIL // Default aGetList to an array
aGetList:={}
ENDIF
// turn on the mouse cursor
mShow()
IF nSeconds == NIL // Wait for a key or a mouse action
IF aMouseState[LLM_STATE_LEFT] == LLM_BUTTON_DOWN
// Left button is down
// Apply mouse action to buttons and gets lists
nReturn := nApplyMouse(aMouseState, aButCtrls, aGetList)
ELSE
// Get key (if any) and apply key
// to buttons and gets lists
nReturn := nApplyKey(INKEY(), aButCtrls, aGetList)
ENDIF
ELSE // wait for either a keystroke, a left
// button click, or until nSeconds have elapsed
nTime := SECONDS() // Initialize timer controler
WHILE ( nReturn := INKEY()) == 0 .AND. ;
!(lLeft := (aMouseState[LLM_STATE_LEFT] == LLM_BUTTON_DOWN)) .AND. ;
!(lRight := (aMouseState[LLM_STATE_RIGHT] == LLM_BUTTON_DOWN)) .AND. ;
IIF (nSeconds > 0, (SECONDS() - nTime) < nSeconds, .T.)
aMouseState := mState()
ENDDO
IF lLeft // Left button is down
// Apply mouse action to buttons and gets lists
nReturn := nApplyMouse(aMouseState, aButCtrls, aGetList)
ELSEIF lRight // Right button is down
nReturn := K_CLIC_OUT
ELSEIF nReturn <> 0 // a key have been striked, apply
nReturn := nApplyKey(nReturn, aButCtrls, aGetList)
ENDIF
ENDIF
// hide the mouse cursor
mHide()
RETURN( nReturn )
*
STATIC FUNCTION nApplyKey(nKey ,; // Key value
aButCtrls ,; // Array of buttons defined with aButtonAdd()
aGetList ; // For use in GetSys.prg, to be able to track buttons OR Gets
)
// Apply a keystroke to the button list
LOCAL nReturn := nKey
LOCAL nI := 0
IF aButCtrls<>NIL // If buttons are defined, try to find if
// the key is an accelerator key
IF (nKey >= 65 .AND. nKey <= 90) .OR. ;
(nKey >= 97 .AND. nKey <= 122)
// If the key is in A-Z or a-z range, take uppercase value
nI := ASC(UPPER(CHR(nKey)))
ELSE // Else take the value
nI := nKey
ENDIF
IF (nI := ASCAN( aButCtrls , { |el| el[BUTTON_ACCELERATOR]==nI } ))<>0
// If the key matches an accelerator key
mHide()
// Display the button in down position
ButtonDisplay(aButCtrls[nI],.F.)
IF aButCtrls[nI,BUTTON_TYPE]==BUTTON_TYPE_KEY
// If the button emulate a key stroke,
// just transalte the value
nReturn := aButCtrls[nI,BUTTON_ACTION]
TONE(0,4) // Wait 4/18 of seconds before to release the button
// Display in up position
ButtonDisplay(aButCtrls[nI],.T.)
ELSE // A code-block must be executed
// As the mouse is not involved, use 0,0 parameters
EVAL(aButCtrls[nI,BUTTON_ACTION],0,0,aButCtrls[nI])
// Display in up position
ButtonDisplay(aButCtrls[nI],.T.)
mShow()
// Return K_ACCELERATOR value as the action
// have already be executed
nReturn := K_ACCELERATOR
ENDIF
ENDIF
ENDIF
RETURN( nReturn )
*
STATIC FUNCTION nApplyMouse(aMouseState ,; // Mouses values
aButCtrls ,; // Array of buttons defined with aButtonAdd()
aGetList ; // For use in GetSys.prg, to be able to track buttons OR Gets
)
// Apply a mouse action to the button list
LOCAL nReturn := 0 // Value to returned by mInkey()
LOCAL aHitButton := {} // Hitted button ptr, if any
LOCAL nTimeStart := 0 // Timer to delay mouse tracking
LOCAL nRow := 0 // Mouse row
LOCAL nCol := 0 // Mouse col
LOCAL nGet := 0 // Position in GetList
LOCAL aMouseClip := {} // Mouse clipping area
mHide()
// Look in the buttons table
IF (aHitButton := aWhichButton(aButCtrls ,;
aMouseState[LLM_STATE_X] ,;
aMouseState[LLM_STATE_Y] ;
) ;
) == NIL
nReturn := 0 // No button find
ELSE
// Clic on aHitButton
mHide()
// Display in down position
ButtonDisplay(aHitButton,.F.)
IF aHitButton[BUTTON_TYPE]==BUTTON_TYPE_KEY
// The button emulates a key stroke
mShow()
// Wait for the mouse to be released inside the button
DO WHILE ( aMouseState := mState() )[LLM_STATE_LEFT] == LLM_BUTTON_DOWN .AND. ;
lMouseInButton(aHitButton,aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y])
ENDDO
mHide()
// If the mouse have been released inside the button
IF lMouseInButton(aHitButton,aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y])
// Return the emulated value
nReturn := aHitButton[BUTTON_ACTION]
ENDIF
ELSE
IF aHitButton[BUTTON_TYPE]==BUTTON_TYPE_RELEASE
// The button must be released before
// action to executed
mShow()
// Wait for the mouse to be released inside the button
DO WHILE ( aMouseState := mState() )[LLM_STATE_LEFT] == LLM_BUTTON_DOWN .AND. ;
lMouseInButton(aHitButton,aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y])
ENDDO
mHide()
// If the mouse have been released inside the button
IF lMouseInButton(aHitButton,aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y])
// EVAL action code block with mouse X-Y and button ptr
EVAL(aHitButton[BUTTON_ACTION],aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y],aHitButton)
ENDIF
ELSEIF aHitButton[BUTTON_TYPE]==BUTTON_TYPE_REPEAT
// The action must be repeated as long as the
// mouse is down
// Initialise a timer
nTimeStart := SECONDS()
// Save previous mouse clipping
aMouseClip := mSetClip()
// EVAL action code block a first time
// with mouse X-Y and button ptr
EVAL(aHitButton[BUTTON_ACTION],aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y],aHitButton)
mShow()
// Wait a little bit before to repeat action
DO WHILE (SECONDS() < nTimeStart + 0.5) .AND. ( aMouseState := mState() )[LLM_STATE_LEFT] == LLM_BUTTON_DOWN .AND. lMouseInButton(aHitButton,aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y])
ENDDO
// Force the mouse to stay inside the button
mSetClip(aHitButton[BUTTON_LEFT] ,;
aHitButton[BUTTON_TOP] ,;
aHitButton[BUTTON_RIGHT] ,;
aHitButton[BUTTON_BOTTOM] ,;
LLM_COOR_GRAPH ;
)
DO WHILE ( aMouseState := mState() )[LLM_STATE_LEFT] == LLM_BUTTON_DOWN .AND. lMouseInButton(aHitButton,aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y])
// While the mouse is down
mHide()
// EVAL action code block with mouse X-Y and button ptr
EVAL(aHitButton[BUTTON_ACTION],aMouseState[LLM_STATE_X],aMouseState[LLM_STATE_Y],aHitButton)
mShow()
ENDDO
// Restore previous mouse clipping area
mSetClip(aMouseClip[1] ,;
aMouseClip[2] ,;
aMouseClip[3] ,;
aMouseClip[4] ,;
LLM_COOR_GRAPH ;
)
ENDIF
nReturn := K_BUTTON // A code-block button have been hitted
ENDIF
mHide()
// Display in up position
ButtonDisplay(aHitButton,.T.)
mShow()
ENDIF
// The clic is not inside controls buttons, try
// Gets if any
IF nReturn == 0 .AND. LEN(aGetList)>0
// Make it faster
nRow := aMouseState[LLM_STATE_ROW]
nCol := aMouseState[LLM_STATE_COL]
// Find the clic inside the gets list
nGet := Ascan(aGetList ,;
{ |o| nRow==o:row .AND. ;
nCol>=o:Col .AND. ;
nCol<=o:Col+Len(Transform(o:Varget(),o:picture))-1 ;
} ;
)
// If a get have been hitted
IF nGet<>0
nHitGet(nGet) // Set the value to allow it to be retrieve in GetSys
nReturn := K_GET // Set the return value to K_GET
ENDIF
ENDIF
// If 0, convert to K_CLIC_OUT
RETURN( IF(nReturn==0,K_CLIC_OUT,nReturn) )
*
FUNCTION nHitGet(nGet) // SetGet function used to manage mouse in gets
STATIC nHitGet
LOCAL nOldHitGet := nHitGet
IF ( PCOUNT() > 0 )
nHitGet := nGet
ENDIF
RETURN nOldHitGet
*
FUNCTION lMouseInButton(aButton ,; // Button ptr
nMouseX ,; // Mouse X position
nMouseY ; // Mouse Y position
)
// Return .T. if mouse is insode button
RETURN( nMouseX >= aButton[BUTTON_LEFT ] .AND. ;
nMouseY >= aButton[BUTTON_TOP ] .AND. ;
nMouseX <= aButton[BUTTON_RIGHT ] .AND. ;
nMouseY <= aButton[BUTTON_BOTTOM] ;
)
*
FUNCTION aWhichButton(aButCtrls ,; // Buttons list
nMouseX ,; // Mouse X position
nMouseY ; // Mouse Y position
)
// Find the button clicked, if any
LOCAL nI := 0 // Loop indice
LOCAL nMaxButton := LEN(aButCtrls) // Len of buttons list
LOCAL nHitButton := 0 // Hitted button position
// Look in the list in reverse order
// this allow to partially cover a large button
// with a smaller one (ie scrollbar)
FOR nI := nMaxButton TO 1 STEP -1
IF lMouseInButton(aButCtrls[nI],nMouseX,nMouseY)
// If the mouse is inside the button
nHitButton := nI
EXIT
ENDIF
NEXT nI
// Return NIL or the button's ptr
RETURN (IF(nHitButton==0,NIL,aButCtrls[nHitButton]))
*
// Group ScrollBar
// Note : Here are some CA-CLIPPER
// functions to allow use of scrollbrs in TBROWSE
// and others situations
/***
*
* aScrollAdd() Add a ScrollBar to a list of buttons
* ScrArrowAction() Execute action mapped to arrows buttons
* ScrCursorAction() Execute action mapped to cursor button
* ScrBarAction() Execute action mapped to bar button
* ScrBarDisplay() Update scrollbar display
* ScrBarUpDate() Update scrollbar internals
*
*/
*
FUNCTION aScrollAdd(nScrollLeft ,; // Scrollbar coordinates
nScrollTop ,; // in graphics mode
nScrollRight ,; // If vertical, must be 16 pixels width
nScrollBottom ,; // If Horizontal, must be 16 pixels height
nScrollType ,; // BUTTON_TYPE_SCROLL_VERT or BUTTON_TYPE_SCROLL_HORI
bArrow1Action ,; // Code-block for left or top button
bArrow2Action ,; // Code-block for Right or bottom button
bScrollCompute ,; // Compute code block
aButCtrls ,; // Button list master handler
aScrollPtr ; // Ptr on this scrollbar
)
// Add a scrollbar to a list of buttons
// a scrollbar is a combination of 4 buttons
// Left/right/bar/cursor. We also need to be
// able to refresh the scrollbar if the related
// object (ie tbrowse ...) is moved, that is the
// reason why we need a ptr on each scrollbar.
// Top/Left and Bottom/Right code-block are obvious
// bScrollCompute is a little be more tricky.
// You should study BrowseHori() in this source
// file to understand the way it runs.
LOCAL nButInCtrls := 0 // Number of buttons in the controls list, before
// we add the scrollbar buttons
IF nScrollType == BUTTON_TYPE_SCROLL_VERT
// Vertical scroll bar
// Add the arrow up button
// It's a repeat button
aButtonAdd(nScrollLeft ,;
nScrollTop ,;
NIL ,;
NIL ,;
BUTTON_TYPE_REPEAT ,;
{ |nMouseX,nMouseY| ScrArrowAction(nMouseX, nMouseY, -1, bArrow1Action, bScrollCompute, aScrollPtr) } ,;
NIL ,;
aBmpBase[ARROW_U_UP] ,;
aBmpBase[ARROW_U_DW] ,;
aButCtrls ;
) ;
// Add the arrow down button
// It's a repeat button
aButtonAdd(nScrollLeft ,;
nScrollBottom-FONT_SIZE_Y ,;
NIL ,;
NIL ,;
BUTTON_TYPE_REPEAT ,;
{ |nMouseX,nMouseY| ScrArrowAction(nMouseX, nMouseY, 1, bArrow2Action, bScrollCompute, aScrollPtr) } ,;
NIL ,;
aBmpBase[ARROW_D_UP] ,;
aBmpBase[ARROW_D_DW] ,;
aButCtrls ;
) ;
// Draw the bar itself
gRect( nScrollLeft ,;
nScrollTop+FONT_SIZE_Y ,;
nScrollRight-1 ,;
nScrollBottom-FONT_SIZE_Y ,;
LLG_FILL ,;
8 ,;
LLG_MODE_SET ;
)
// Add the large bar button
// It's a release button
aButtonAdd(nScrollLeft ,;
nScrollTop+FONT_SIZE_Y ,;
nScrollRight-1 ,;
nScrollBottom-FONT_SIZE_Y ,;
BUTTON_TYPE_RELEASE ,;
{ |nMouseX,nMouseY,aButton| ScrBarAction(nMouseX ,;
nMouseY ,;
aButton ,;
bScrollCompute ,;
nScrollLeft ,;
nScrollTop+FONT_SIZE_Y ,;
nScrollRight-1 ,;
nScrollBottom-FONT_SIZE_Y,;
nScrollType ,;
aButCtrls ,;
aScrollPtr ;
) ;
} ,;
NIL ,;
NIL ,;
NIL ,;
aButCtrls ;
) ;
// Add the cursor button
// It's a repeat button
aButtonAdd(nScrollLeft ,;
(nScrollTop+FONT_SIZE_Y)+(nScrollBottom-nScrollTop-3*FONT_SIZE_Y)*EVAL(bScrollCompute,NIL,NIL)+1 ,;
NIL ,;
NIL ,;
BUTTON_TYPE_REPEAT ,;
{ |nMouseX,nMouseY,aButton| ScrCursorAction(nMouseX ,;
nMouseY ,;
aButton ,;
bScrollCompute ,;
nScrollLeft ,;
nScrollTop+FONT_SIZE_Y+1 ,;
nScrollRight-1 ,;
nScrollBottom-FONT_SIZE_Y-1 ,;
nScrollType ,;
aButCtrls ,;
aScrollPtr ;
) ;
} ,;
NIL ,;
aBmpBase[ARROW_E_UP] ,;
aBmpBase[ARROW_E_DW] ,;
aButCtrls ;
) ;
ELSEIF nScrollType == BUTTON_TYPE_SCROLL_HORI
// Horizontal scroll bar
// Add the arrow left button
// It's a repeat button
aButtonAdd(nScrollLeft ,;
nScrollBottom-FONT_SIZE_Y ,;
NIL ,;
NIL ,;
BUTTON_TYPE_REPEAT ,;
{ |nMouseX,nMouseY| ScrArrowAction(nMouseX, nMouseY, -1, bArrow1Action, bScrollCompute,aScrollPtr) } ,;
NIL ,;
aBmpBase[ARROW_L_UP] ,;
aBmpBase[ARROW_L_DW] ,;
aButCtrls ;
) ;
// Add the arrow right button
// It's a repeat button
aButtonAdd(nScrollRight-2*FONT_SIZE_X ,;
nScrollBottom-FONT_SIZE_Y ,;
NIL ,;
NIL ,;
BUTTON_TYPE_REPEAT ,;
{ |nMouseX,nMouseY| ScrArrowAction(nMouseX, nMouseY, 1, bArrow2Action, bScrollCompute, aScrollPtr) } ,;
NIL ,;
aBmpBase[ARROW_R_UP] ,;
aBmpBase[ARROW_R_DW] ,;
aButCtrls ;
) ;
// Draw the bar itself
gRect( nScrollLeft+2*FONT_SIZE_X ,;
nScrollTop ,;
nScrollRight-2*FONT_SIZE_X ,;
nScrollBottom-1 ,;
LLG_FILL ,;
8 ,;
LLG_MODE_SET ;
)
// Add the large bar button
// It's a release button
aButtonAdd(nScrollLeft+2*FONT_SIZE_X ,;
nScrollTop ,;
nScrollRight-2*FONT_SIZE_X ,;
nScrollBottom-1 ,;
BUTTON_TYPE_RELEASE ,;
{ |nMouseX,nMouseY,aButton| ScrBarAction(nMouseX ,;
nMouseY ,;
aButton ,;
bScrollCompute ,;
nScrollLeft+2*FONT_SIZE_X ,;
nScrollTop ,;
nScrollRight-2*FONT_SIZE_X,;
nScrollBottom-1 ,;
nScrollType ,;
aButCtrls ,;
aScrollPtr ;
) ;
} ,;
NIL ,;
NIL ,;
NIL ,;
aButCtrls ;
) ;
// Add the cursor button
// It's a repeat button
aButtonAdd((nScrollLeft+2*FONT_SIZE_X)+(nScrollRight-nScrollLeft-6*FONT_SIZE_X)*EVAL(bScrollCompute,NIL,NIL) ,;
nScrollTop ,;
NIL ,;
NIL ,;
BUTTON_TYPE_REPEAT ,;
{ |nMouseX,nMouseY,aButton| ScrCursorAction(nMouseX ,;
nMouseY ,;
aButton ,;
bScrollCompute ,;
nScrollLeft+2*FONT_SIZE_X ,;
nScrollTop ,;
nScrollRight-2*FONT_SIZE_X ,;
nScrollBottom-1 ,;
nScrollType ,;
aButCtrls ,;
aScrollPtr ;
) ;
} ,;
NIL ,;
aBmpBase[ARROW_E_UP] ,;
aBmpBase[ARROW_E_DW] ,;
aButCtrls ;
) ;
ENDIF
nButInCtrl := LEN(aButCtrls)
AADD(aScrollPtr, aButCtrls[nButInCtrl-3] ) // Left or top button
AADD(aScrollPtr, aButCtrls[nButInCtrl-2] ) // Right or bottom button
AADD(aScrollPtr, aButCtrls[nButInCtrl-1] ) // bar button
AADD(aScrollPtr, aButCtrls[nButInCtrl] ) // cursor button
AADD(aScrollPtr, nScrollType ) // Scrollbar type
RETURN ( aScrollPtr )
*
FUNCTION ScrArrowAction(nMouseX ,; // Mouse X location
nMouseY ,; // Mouse Y location
nSens ,; // Move direction (-1=>left/up 1=>Right/down)
bArrow1Action ,; // Action linked to the button
bScrollCompute ,; // Percentage code-block
aScrollPtr ; // Ptr on Scroll
)
// Eval action
EVAL(bArrow1Action,nMouseX,nMouseY)
// Update scrollbar location
ScrBarUpDate(aScrollPtr,EVAL(bScrollCompute,nSens,0))
RETURN (NIL)
*
FUNCTION ScrCursorAction(nMouseX ,; // Mouse X location
nMouseY ,; // Mouse Y location
aButCur ,; // Ptr on cursor button
bScrollCompute ,; // Percentage code-block
nScrollLeft ,; // Scroll pixels coordinates
nScrollTop ,; //
nScrollRight ,; //
nScrollBottom ,; //
nScrollType ,; // Scrolltype (Hori|vert)
aButCtrls ,; // List of all buttons
aScrollPtr ; // Ptr on scroll
)
LOCAL nPercent := 0 // Cursor position (in %) in the scrollbar
// Ptr on the cursor button
LOCAL aButBar := aScrollPtr[3]
// While the mouse is inside the button
IF ( nMouseX >= nScrollLeft .AND. ;
nMouseY >= nScrollTop .AND. ;
nMouseX <= nScrollRight .AND. ;
nMouseY <= nScrollBottom ;
)
IF nScrollType == BUTTON_TYPE_SCROLL_VERT
// Vertical scroll
// Force mouse to stay inside the bar
IF nMouseY <= nScrollTop+(FONT_SIZE_Y/2)
nMouseY := nScrollTop+(FONT_SIZE_Y/2)
ENDIF
IF nMouseY >= nScrollBottom-(FONT_SIZE_Y/2)
nMouseY := nScrollBottom-(FONT_SIZE_Y/2)
ENDIF
// Compute a % value
nPercent := (nMouseY-nScrollTop-(FONT_SIZE_Y/2))/(nScrollBottom-nScrollTop-FONT_SIZE_Y)
// Move the button coodinate
aButCur[BUTTON_TOP] := nMouseY-(FONT_SIZE_Y/2)
aButCur[BUTTON_BOTTOM] := aButCur[BUTTON_TOP] + aButCur[BUTTON_HEIGHT]
ELSEIF nScrollType == BUTTON_TYPE_SCROLL_HORI
// Horizontal scroll
// Force mouse to stay inside the bar
IF nMouseX <= nScrollLeft+FONT_SIZE_X
nMouseX := nScrollLeft+FONT_SIZE_X
ENDIF
IF nMouseX >= nScrollRight-FONT_SIZE_X
nMouseX := nScrollRight-FONT_SIZE_X
ENDIF
// Compute a % value
nPercent := (nMouseX-nScrollLeft-FONT_SIZE_X)/(nScrollRight-nScrollLeft-2*FONT_SIZE_X)
// Move the button coodinate
aButCur[BUTTON_LEFT] := nMouseX-FONT_SIZE_X
aButCur[BUTTON_RIGHT] := aButCur[BUTTON_LEFT] + aButCur[BUTTON_WIDTH]
ENDIF
// Reset clipping area (the cursor button is
// a repeat button, so a clipping area have been
// defined and need to be moved as the button is moved
mSetClip( aButCur[BUTTON_LEFT] ,;
aButCur[BUTTON_TOP] ,;
aButCur[BUTTON_RIGHT] ,;
aButCur[BUTTON_BOTTOM] ,;
LLM_COOR_GRAPH ;
)
// Redisplay all the bar with cursor button in
// down position
ScrBarDisplay(aButBar ,;
aButCur ,;
nScrollType ,;
.F. ;
)
// EVAL the compute block with the new value
EVAL(bScrollCompute,0,nPercent)
ENDIF
RETURN (NIL)
*
FUNCTION ScrBarAction(nMouseX ,; // Mouse X location
nMouseY ,; // Mouse Y location
aButBar ,; // Ptr on bar button
bScrollCompute ,; // Percentage code-block
nScrollLeft ,; // Scroll pixels coordinates
nScrollTop ,; //
nScrollRight ,; //
nScrollBottom ,; //
nScrollType ,; // Scrolltype (Hori|vert)
aButCtrls ,; // List of all buttons
aScrollPtr ; // Ptr on scroll
)
LOCAL nPercent := 0 // Cursor position (in %) in the scrollbar
// Ptr on the bar button
LOCAL aButCur := aScrollPtr[4]
IF nScrollType == BUTTON_TYPE_SCROLL_VERT
// Vertical scroll
// Force mouse to stay inside the bar
IF nMouseY <= nScrollTop+(FONT_SIZE_Y/2)
nMouseY := nScrollTop+(FONT_SIZE_Y/2)
ENDIF
IF nMouseY >= nScrollBottom-(FONT_SIZE_Y/2)
nMouseY := nScrollBottom-(FONT_SIZE_Y/2)
ENDIF
// Compute a % value
nPercent := (nMouseY-nScrollTop-(FONT_SIZE_Y/2))/(nScrollBottom-nScrollTop-FONT_SIZE_Y)
// Move the button coordinates
aButCur[BUTTON_TOP] := nMouseY-(FONT_SIZE_Y/2)
aButCur[BUTTON_BOTTOM] := aButCur[BUTTON_TOP] + aButCur[BUTTON_HEIGHT]
ELSEIF nScrollType == BUTTON_TYPE_SCROLL_HORI
// Horizontal scroll
// Force mouse to stay inside the bar
IF nMouseX <= nScrollLeft+FONT_SIZE_X
nMouseX := nScrollLeft+FONT_SIZE_X
ENDIF
IF nMouseX >= nScrollRight-FONT_SIZE_X
nMouseX := nScrollRight-FONT_SIZE_X
ENDIF
// Compute a % value
nPercent := (nMouseX-nScrollLeft-FONT_SIZE_X)/(nScrollRight-nScrollLeft-2*FONT_SIZE_X)
// Move the button coordinates
aButCur[BUTTON_LEFT] := nMouseX-FONT_SIZE_X
aButCur[BUTTON_RIGHT] := aButCur[BUTTON_LEFT] + aButCur[BUTTON_WIDTH]
ENDIF
// EVAL the compute block with the new value
EVAL(bScrollCompute,0,nPercent)
// Redisplay all the bar with cursor button in
// up position
ScrBarDisplay(aButBar ,;
aButCur ,;
nScrollType ,;
.T. ;
)
RETURN (NIL)
*
FUNCTION ScrBarDisplay(aButBar ,; // Bar button ptr
aButCur ,; // Cursor button ptr
nScrollType ,; // Scrollbar type
lDisplayUp ; // Display mode
)
mHide()
IF nScrollType == BUTTON_TYPE_SCROLL_VERT
// Vertical scroll
// Clear the upperside of the stripe
gRect( aButBar[BUTTON_LEFT] ,;
aButBar[BUTTON_TOP]+1 ,;
aButBar[BUTTON_RIGHT] ,;
aButCur[BUTTON_TOP]-1 ,;
LLG_FILL ,;
8 ,;
LLG_MODE_SET ;
)
// Display the cursor
gBmpDisp( IF( lDisplayUp ,;
aButCur[BUTTON_ICO_UP] ,;
aButCur[BUTTON_ICO_DOWN] ;
) ,;
aButCur[BUTTON_LEFT] ,;
aButCur[BUTTON_TOP ] ,;
)
// Clear the down side of the stripe
gRect( aButBar[BUTTON_LEFT] ,;
aButCur[BUTTON_BOTTOM]+2 ,;
aButBar[BUTTON_RIGHT] ,;
aButBar[BUTTON_BOTTOM]-1 ,;
LLG_FILL ,;
8 ,;
LLG_MODE_SET ;
)
ELSEIF nScrollType == BUTTON_TYPE_SCROLL_HORI
// Horizontal scroll
// Clear the left of the stripe
gRect( aButBar[BUTTON_LEFT]+1 ,;
aButBar[BUTTON_TOP] ,;
aButCur[BUTTON_LEFT]-1 ,;
aButBar[BUTTON_BOTTOM] ,;
LLG_FILL ,;
8 ,;
LLG_MODE_SET ;
)
// Display the cursor
gBmpDisp( IF( lDisplayUp ,;
aButCur[BUTTON_ICO_UP] ,;
aButCur[BUTTON_ICO_DOWN] ;
) ,;
aButCur[BUTTON_LEFT] ,;
aButCur[BUTTON_TOP ] ,;
)
// Clear the right of the stripe
gRect( aButCur[BUTTON_RIGHT]+2 ,;
aButBar[BUTTON_TOP] ,;
aButBar[BUTTON_RIGHT]-1 ,;
aButBar[BUTTON_BOTTOM] ,;
LLG_FILL ,;
8 ,;
LLG_MODE_SET ;
)
ENDIF
mShow()
RETURN (NIL)
*
FUNCTION ScrBarUpDate(aScroll ,; // Ptr on scrollbar
nPercent ; // Percentage
)
LOCAL nPos := 0 // Position in pixels
LOCAL aButBar := aScroll[3] // Bar button
LOCAL aButCur := aScroll[4] // Cursor button
LOCAL nScrollType := aScroll[5] // Scroll type
IF nScrollType == BUTTON_TYPE_SCROLL_VERT
// Vertical scroll
// Compute the cursor position
nPos := nPercent*(aButBar[BUTTON_BOTTOM]-aButBar[BUTTON_TOP]-FONT_SIZE_Y)+aButBar[BUTTON_TOP]+(FONT_SIZE_Y/2)
// Move the button coordinates
aButCur[BUTTON_TOP] := nPos-(FONT_SIZE_Y/2)
aButCur[BUTTON_BOTTOM] := aButCur[BUTTON_TOP] + aButCur[BUTTON_HEIGHT]
ELSEIF nScrollType == BUTTON_TYPE_SCROLL_HORI
// Horizontal scroll
// Compute the cursor position
nPos := nPercent*(aButBar[BUTTON_RIGHT]-aButBar[BUTTON_LEFT]-2*FONT_SIZE_X)+aButBar[BUTTON_LEFT]+FONT_SIZE_X
// Move the button coordinates
aButCur[BUTTON_LEFT] := nPos-FONT_SIZE_X
aButCur[BUTTON_RIGHT] := aButCur[BUTTON_LEFT] + aButCur[BUTTON_WIDTH]
ENDIF
// Display scrollbar with cursor in up position
ScrBarDisplay(aButBar ,;
aButCur ,;
nScrollType ,;
.T. ;
)
RETURN (NIL)
*
// Group Potentiometers
// Note : Here are some CA-CLIPPER
// functions to allow use of potentiometers
/***
*
* aPotAdd() Create a new potentiometers
* nPotSetGet() Manage changes in potentiometer value
* nPotDisplay() Display pictured value left to potentiometer
*
*/
*
FUNCTION aPotAdd(nPotLeft ,; // Left in columns
nPotTop ,; // Top in rows
nPotWidth ,; // Width in columns
bValSetGet ,; // Set/Get block
bExeChange ,; // Block to execute when value change
nValMin ,; // Minimum value
nValMax ,; // Maximum value
cValPic ,; // Picture value
aButCtrls ,; // General button handler
aPotent ; // This object handler
)
// Create a new potentiometer
// Translate values to pixels
LOCAL nLeft := nPotLeft * FONT_SIZE_X
LOCAL nTop := nPotTop * FONT_SIZE_Y
LOCAL nBottom := (nPotTop+1) * FONT_SIZE_Y
LOCAL nRightMid := 0
LOCAL nRightEnd := 0
// Default to NIL code-block
IF bExeChange == NIL
bExeChange := { || NIL }
ENDIF
// Default minimum value to 0
IF nValMin == NIL
nValMin := 0
ENDIF
// Default maximum value to 100
IF nValMax == NIL
nValMax := 100
ENDIF
// Default picture value to '999%'
IF cValPic == NIL
cValPic := "999%"
ENDIF
// Compute end of scrollbar and begining of
// pictured display
nRightMid := (nPotLeft+nPotWidth-LEN(cValPic))*FONT_SIZE_X
nRightEnd := (nPotLeft+nPotWidth)*FONT_SIZE_X
// Create a scroll
aScrollAdd(nLeft ,;
nTop ,;
nRightMid ,;
nBottom ,;
BUTTON_TYPE_SCROLL_HORI ,;
{ |nMouseX,nMouseY| nPotSetGet(bValSetGet,nValMin,nValMax,cValPic, -1, NIL,nRightMid,nTop,nRightEnd,nBottom,bExeChange) } ,;
{ |nMouseX,nMouseY| nPotSetGet(bValSetGet,nValMin,nValMax,cValPic, 1, NIL,nRightMid,nTop,nRightEnd,nBottom,bExeChange) } ,;
{ |nSens,nPercent| nPotSetGet(bValSetGet,nValMin,nValMax,cValPic,nSens,nPercent,nRightMid,nTop,nRightEnd,nBottom,bExeChange) } ,;
aButCtrls ,;
aPotent ;
)
AADD(aPotent, { |nValue| nPotDisplay(nValue, cValPic, nRightMid,nTop,nRightEnd,nBottom ) } )
// Initialize values
nPotSetGet(bValSetGet,nValMin,nValMax,cValPic, NIL, NIL,nRightMid,nTop,nRightEnd,nBottom,bExeChange)
RETURN (aPotent)
*
FUNCTION nPotSetGet(bValSetGet ,; // Get/Set block
nValMin ,; // Minimum value
nValMax ,; // Maximum value
cValPic ,; // Picture
nSens ,; // NIL, -1 , 1
nPercent ,; // NIL, 0 , -1 , 1
nLeft ,; // pictured value frame location in pixels
nTop ,; //
nRight ,; //
nBottom ,; //
bExeChange ; // Block to be executed when the value change
)
// Manage changes in potentiometer value
// Retrieve value from Get/Set block
LOCAL nValue := EVAL(bValSetGet)
IF nSens <> NIL // If nSens is not NIL, value must be SET
IF nSens == 0 // If nSens==0, value is deducted from nPercent
nValue := EVAL( bValSetGet , nValMin+INT((nValMax-nValMin)*nPercent) )
ELSE // Increment or decrement value
// Use Get/Set block to set new value
nValue := EVAL( bValSetGet , nValue+nSens )
// Minimize - Maximize value
IF nValue < nValMin
nValue := EVAL( bValSetGet , nValMin )
ELSEIF nValue>nValMax
nValue := EVAL( bValSetGet , nValMax )
ENDIF
ENDIF
ENDIF
// Display pictured value
nPotDisplay(nValue, cValPic, nLeft, nTop, nRight, nBottom )
// Eval something when value changes
EVAL(bExeChange)
RETURN ((nValue-nValMin)/(nValMax-nValMin))
*
FUNCTION nPotDisplay(nValue ,; // Value to be displayed
cValPic ,; // Picture
nLeft ,; // pictured value frame location in pixels
nTop ,; //
nRight ,; //
nBottom ; //
)
// Display pictured value left to potentiometer
// Display a frame
gFrame( nLeft ,;
nTop ,;
nRight ,;
nBottom-1 ,;
7, 15, 8, 1, 1, 1, 1, LLG_MODE_SET )
// Write value inside
gWriteAt( nLeft+1 ,;
nTop+1 ,;
TRANSFORM(nValue,cValPic) ,;
0 ,;
LLG_MODE_SET ;
)
RETURN (NIL)
*
// Group Odometer/Gauge
// Note : Here are some CA-CLIPPER
// functions to allow use of odometers and gauges
/***
*
* lOdometer() Create/Use/Delete an odometer
* lGauge() Create/Use/Delete a gauge
*
*/
*
FUNCTION lOdometer(xMode ,; // ODOME_INIT | ODOME_IDLE==(NIL) | ODOME_EXIT
aHandle ,; // NIL if only one object at a time, a {} ptr in the other cases
nTop ,; // Location in column
nLeft ; // Location in row
)
// Create/Use/Delete an odometer
LOCAL lContinue := .T. // Default return value
// Couples of coordinates
STATIC aPoints := { { 8, 3} , { 9, 3} , {10, 3} , {11, 3} , {12, 3} ,;
{12, 4} , {12, 5} , {12, 6} , {12, 7} , {12, 8} , {12, 9} , {12,10} , {12,11} , {12,12} ,;
{11,12} , {10,12} , { 9,12} , { 8,12} , { 7,12} , { 6,12} , { 5,12} , { 4,12} , { 3,12} ,;
{ 3,11} , { 3,10} , { 3, 9} , { 3, 8} , { 3, 7} , { 3, 6} , { 3, 5} , { 3, 4} , { 3, 3} ,;
{ 4, 3} , { 5, 3} , { 6, 3} , { 7, 3} ;
}
STATIC aDefHandle := {} // Default handle if not defined
IF aHandle<>NIL // If an handle is define, use the defined one
aDefHandle := aHandle
ENDIF
IF xMode == ODOME_IDLE // idle case
aDefHandle[8]++ // increase the value
// each turn, change color by switching .T./.F.
IF aDefHandle[8] > 36
aDefHandle[8] := 1
aDefHandle[9] := !aDefHandle[9]
ENDIF
// gLine from the center to one of the point
gLine(aDefHandle[4] ,;
aDefHandle[5] ,;
aDefHandle[6]+aPoints[aDefHandle[8],1] ,;
aDefHandle[7]+aPoints[aDefHandle[8],2] ,;
IF(aDefHandle[9],2,4) ,;
LLG_MODE_SET ;
)
IF INKEY()==K_ESC // If ESC, return a .F. value
lContinue := .F.
ENDIF
ELSEIF xMode == ODOME_INIT
// Init case
ASIZE(aDefHandle,0) // Resize aDefHandle if needed
// 1 - Save back
AADD(aDefHandle,SAVESCREEN(nTop,nLeft,nTop,nLeft+1))
AADD(aDefHandle,nTop) // 2 - Top in row
AADD(aDefHandle,nLeft) // 3 - Left in row
AADD(aDefHandle,(nLeft+1)*FONT_SIZE_X) // 4 - X center in pixels
AADD(aDefHandle,(nTop+.5)*FONT_SIZE_Y) // 5 - Y center in pixels
AADD(aDefHandle,nLeft*FONT_SIZE_X) // 6 - Left in pixels
AADD(aDefHandle,nTop*FONT_SIZE_Y) // 7 - Top in pixels
AADD(aDefHandle,1) // 8 - Last position
AADD(aDefHandle,.T.) // 9 - Color switch
// Display a frame
gFrame(nLeft*FONT_SIZE_X ,;
nTop*FONT_SIZE_Y ,;
(nLeft+2)*FONT_SIZE_X-1 ,;
(nTop+1)*FONT_SIZE_Y-1 ,;
07 ,;
15 ,;
00 ,;
3, 3, 3, 3, LLG_MODE_SET ;
)
ELSEIF xMode == ODOME_EXIT
// Exit case
// Restore the screen
RESTSCREEN(aDefHandle[2],aDefHandle[3],aDefHandle[2],aDefHandle[3]+1,aDefHandle[1])
// Resize the handle
// (do not replace by aDefHandle:={} to allow caller
// function to point on the same value)
ASIZE(aDefHandle,0)
ENDIF
RETURN (lContinue)
*
FUNCTION lGauge(xMode ,; // GAUGE_INIT | GAUGE_IDLE==(NIL) | GAUGE_EXIT
aHandle ,; // NIL if only one object at a time, a {} ptr in the other cases
nType ,; // Gauge type GAUGE_HORI | GAUGE_VERT
nTop ,; // Location in column
nLeft ,; // Location in row
nExtend ,; // Lenght or width in column or row
bMaxVal ,; // Maximum value to be reached
bCurVal ; // Curent value, should be in 0-Max value range
)
LOCAL lContinue := .T. // Default return value
LOCAL nI := 0 // For/next loop indice
STATIC aDefHandle := {} // Default handle if not defined
IF aHandle<>NIL // If an handle is define, use the defined one
aDefHandle := aHandle
ENDIF
IF xMode == GAUGE_IDLE // Idle case
IF aDefHandle[12]==GAUGE_HORI
// Horizontal gauge
// Display a rectangle from left to the value
gRect(aDefHandle[4] ,;
aDefHandle[5] ,;
aDefHandle[4]+(aDefHandle[3]*EVAL(aDefHandle[7])/aDefHandle[2]) ,;
aDefHandle[6] ,;
LLG_FILL ,;
2 ,;
LLG_MODE_SET ;
)
ELSEIF aDefHandle[12]==GAUGE_VERT
// Vertical gauge
// Display a rectangle from bottom to the value
gRect(aDefHandle[4] ,;
aDefHandle[6] ,;
aDefHandle[5] ,;
aDefHandle[6]-(aDefHandle[3]*EVAL(aDefHandle[7])/aDefHandle[2]) ,;
LLG_FILL ,;
2 ,;
LLG_MODE_SET ;
)
ENDIF
IF INKEY()==K_ESC // If ESC, return a .F. value
lContinue := .F.
ENDIF
ELSEIF xMode == GAUGE_INIT
// Init case
ASIZE(aDefHandle,0) // Resize aDefHandle if needed
IF nType==GAUGE_HORI
// Horizontal gauge
// 1 - Save gauge back
AADD(aDefHandle,SAVESCREEN(nTop,nLeft,nTop+1,nLeft+nExtend))
AADD(aDefHandle,EVAL(bMaxVal)) // 2 - Max value
AADD(aDefHandle,nExtend*FONT_SIZE_X-6) // 3 - Width available in pixels
AADD(aDefHandle,nLeft*FONT_SIZE_X+3) // 4 - Left available
AADD(aDefHandle,nTop*FONT_SIZE_Y+3) // 5 - Top available
AADD(aDefHandle,(nTop+1)*FONT_SIZE_Y-4) // 6 - Bottom available
AADD(aDefHandle,bCurVal) // 7 - Block to retrieve current value
AADD(aDefHandle,nTop) // 8 - Top of save screen
AADD(aDefHandle,nLeft) // 9 - Left ...
AADD(aDefHandle,nTop+1) // 10 - Bottom ...
AADD(aDefHandle,nLeft+nExtend) // 11 - Right ...
AADD(aDefHandle,nType) // 12 - Type Hori/Vert
// Display gauge frame
gFrame(nLeft*FONT_SIZE_X ,;
nTop*FONT_SIZE_Y ,;
(nLeft+nExtend)*FONT_SIZE_X ,;
(nTop+1)*FONT_SIZE_Y-1 ,;
07 ,;
15 ,;
00 ,;
3, 3, 3, 3, LLG_MODE_SET ;
)
// Display 9 separators
FOR nI := 1 TO 9
gLine(aDefHandle[4]+aDefHandle[3]*nI/10 ,;
aDefHandle[6] ,;
aDefHandle[4]+aDefHandle[3]*nI/10 ,;
aDefHandle[6]-IF(nI==5,5,2) ,;
00 ,;
LLG_MODE_SET ;
)
NEXT nI
ELSEIF nType==GAUGE_VERT
// Vertical gauge
// 1 - Save gauge back
AADD(aDefHandle,SAVESCREEN(nTop,nLeft,nTop+nExtend,nLeft+2))
AADD(aDefHandle,EVAL(bMaxVal)) // 2 - Max value
AADD(aDefHandle,nExtend*FONT_SIZE_Y-6) // 3 - Height available in pixels
AADD(aDefHandle,nLeft*FONT_SIZE_X+3) // 4 - Left available
AADD(aDefHandle,(nLeft+2)*FONT_SIZE_X-4) // 5 - Right available
AADD(aDefHandle,(nTop+nExtend)*FONT_SIZE_Y-4)// 6 - Bottom available
AADD(aDefHandle,bCurVal) // 7 - Block to retrieve current value
AADD(aDefHandle,nTop) // 8 - Top of save screen
AADD(aDefHandle,nLeft) // 9 - Left ...
AADD(aDefHandle,nTop+nExtend) // 10 - Bottom ...
AADD(aDefHandle,nLeft+2) // 11 - Right ...
AADD(aDefHandle,nType) // 12 - Type Hori/Vert
// Display gauge frame
gFrame(nLeft*FONT_SIZE_X ,;
nTop*FONT_SIZE_Y ,;
(nLeft+2)*FONT_SIZE_X-1 ,;
(nTop+nExtend)*FONT_SIZE_Y-1 ,;
07 ,;
15 ,;
00 ,;
3, 3, 3, 3, LLG_MODE_SET ;
)
// Display 9 separators
FOR nI := 1 TO 9
gLine(aDefHandle[4] ,;
aDefHandle[6]-aDefHandle[3]*nI/10 ,;
aDefHandle[4]+IF(nI==5,5,2) ,;
aDefHandle[6]-aDefHandle[3]*nI/10 ,;
00 ,;
LLG_MODE_SET ;
)
NEXT nI
ENDIF
ELSEIF xMode == GAUGE_EXIT
// Exit case
// Restore the screen
RESTSCREEN(aDefHandle[8],aDefHandle[9],aDefHandle[10],aDefHandle[11],aDefHandle[1])
// Resize the handle
// (do not replace by aDefHandle:={} to allow caller
// function to point on the same value)
ASIZE(aDefHandle,0)
ENDIF
RETURN (lContinue)
*
// Group TBDEMO
// Note : Here are some CA-CLIPPER
// functions to allow use of scrollbar in TBDEMO
/***
*
* BrowseVert() Link database and screen pointer
* BrowseHori() Link database and screen pointer
* BrowseClic() Manage clic inside browse cells
*
*/
*
FUNCTION BrowseVert(nSens ,; // NIL, -1, 0, 1
nPercent ,; // NIL or 0 to 1
oBrowse ; // Browse pointer
)
IF nSens <> NIL // Move the pointer
IF nSens == 0 // Set the position depending on %
// MAX Prevent from DBGOTO(0) when % is small
DBGOTO(INT(MAX(1,nPercent*LASTREC())))
oBrowse:refreshAll()
ELSEIF nSens == -1 // Move up
oBrowse:up()
ELSEIF nSens == 1 // Move down
oBrowse:down()
ENDIF
ELSE // nSens==NIL just mean : what is location in %
ENDIF
// Return location in %
RETURN (RECNO()/LASTREC())
*
FUNCTION BrowseHori(nSens ,; // NIL, -1, 0, 1
nPercent ,; // NIL or 0 to 1
oBrowse ; // Browse pointer
)
IF nSens <> NIL
IF nSens == 0 // Move the pointer
// Set the position depending on %
// MAX and MIN prevent overriding browse bounds
oBrowse:ColPos := INT(MIN(oBrowse:ColCount,MAX(oBrowse:freeze,oBrowse:freeze+nPercent*(oBrowse:colCount-oBrowse:freeze))))
ELSEIF nSens==1 // Move right
IF oBrowse:ColPos < oBrowse:ColCount
oBrowse:ColPos := oBrowse:ColPos + 1
ENDIF
ELSEIF nSens==-1 // Move left
IF oBrowse:ColPos > oBrowse:Freeze
oBrowse:ColPos := oBrowse:ColPos - 1
ENDIF
ENDIF
ELSE // nSens==NIL mean : what is location in %
ENDIF
// If ColPos==1, % ==0
// Else dont forget freeze
RETURN (IF(oBrowse:ColPos==1,0,(oBrowse:ColPos-oBrowse:freeze)/(oBrowse:colCount-oBrowse:freeze)))
*
FUNCTION BrowseClic(nMouseX ,; // X Mouse location
nMouseY ,; // Y Mouse location
oBrowse ,; // Browse pointer
nTopLines ; // Number of top line (heading, headsep)
)
LOCAL nHitCol := INT(nMouseX/FONT_SIZE_X)
LOCAL nHitRow := INT(nMouseY/FONT_SIZE_Y)
LOCAL lPosFound := .F.
LOCAL nOldCol := 0
LOCAL nNewCol := 0
LOCAL nI := 0
IF nTopLines == NIL
// Assume heading is only one line and
// headsep is also one line
nTopLines := 2
ENDIF
mHide() // Show mouse
// Find col pointed by mouse
// Use COL() with CURSOR ON to find column
// locations on the tbrowse screen
SET CURSOR ON
// Goto left visible column
oBrowse:Home()
// Scan all visible column
FOR nI := oBrowse:leftVisible TO oBrowse:RightVisible-1
oBrowse:Right()
oBrowse:forceStable()
nNewCol:=COL()
IF nOldCol<=nHitCol .AND. nHitCol<nNewCol
lPosFound := .T.
oBrowse:colPos := nI
EXIT // Clic column found, EXIT FOR/NEXT
ENDIF
nOldCol := nNewCol
NEXT nI
SET CURSOR OFF // Turn cursor OFF
IF !lPosFound // Not found --> Column probably freezed
oBrowse:colPos := oBrowse:RightVisible
ENDIF
// Find row pointed by mouse
oBrowse:rowpos := nHitRow-(oBrowse:nTop+nTopLines)+1
// Resfresh and stabilize
oBrowse:refreshall()
oBrowse:forceStable()
mShow() // Show mouse
RETURN (NIL)
*
// Group Message Box
// Note : Here are some very simples
// CA-CLIPPER generics functions,
// to allow use of message boxes
/***
*
* nMessageBox() Draw a modal message box
* the user choose the mode.
*
*/
*
FUNCTION nMessageBox(cMessage ,; // Message string
cTitle ,; // Box title
xOptions ,; // Option : An array of string or one MB_ define
xIcon ; // Icon to be displayed MB_ICON_QUESTION /.._EXCLAMATION /.._STOP /.._INFO
)
LOCAL aOptions := {} // Array of options
LOCAL nTop := 0 // Top of box
LOCAL nLeft := 0 // Left of box
LOCAL nHeight := 0 // Box height
LOCAL nWidth := 0 // Box width
LOCAL nI := 0 // Loop variable
LOCAL nJ := 0 // Loop variable
LOCAL nKey := 0 // Keyboard inkey value
LOCAL nOptLeft := 0 // Options left position
LOCAL nOptLen := 0 // Options len of display
LOCAL nButLen := 0 // Len of buttons
LOCAL aMessage := {} // Message Array
LOCAL nMessLen := 0 // Max message len
LOCAL nSaveRow := ROW() // Save screen state
LOCAL nSaveCol := COL()
LOCAL nSaveCur := SETCURSOR()
LOCAL xSaveScr := NIL
LOCAL aWinButtons := {} // Buttons Handler
LOCAL lExitAllowed := .F. // Main loop controler
SETCURSOR(0)
nMessLen := 0 // Max message len
IF VALTYPE(cMessage)<>"C"
// If message undefined, default to ""
aMessage := {""}
ELSE
// Use ; to force message to be splited
DO WHILE LEN(cMessage)>0
IF (nI:=AT(';',cMessage))==0
// Store messages in aMessage
AADD(aMessage,cMessage)
cMessage := ''
ELSE
AADD(aMessage,LEFT(cMessage,nI-1))
cMessage := RIGHT(cMessage,LEN(cMessage)-nI)
ENDIF
nMessLen := MAX(nMessLen,LEN(ATAIL(aMessage)))
ENDDO
ENDIF
// If title undefined, default to ""
IF VALTYPE(cTitle)<>"C"
cTitle := ""
ENDIF
// Compute MB_ buttons options
IF VALTYPE(xOptions)=="N"
IF xOptions==MB_OK
aOptions := {"Ok"}
ELSEIF xOptions==MB_OK_CANCEL
aOptions := {"Ok","Cancel"}
ELSEIF xOptions==MB_ABORT_RETRY_IGNORE
aOptions := {"Abort","Retry","Ignore"}
ELSEIF xOptions==MB_YES_NO_CANCEL
aOptions := {"Yes","No","Cancel"}
ELSEIF xOptions==MB_YES_NO
aOptions := {"Yes","No"}
ELSEIF xOptions==MB_RETRY_CANCEL
aOptions := {"Retry","Cancel"}
ENDIF
ELSEIF VALTYPE(xOptions)=="A"
// An array of string is passed, use it as options
aOptions := xOptions
ELSE // Default to Ok
aOptions := {"Ok"}
ENDIF
nButLen := 0 // Determine max width of buttons
FOR nI := 1 TO LEN(aOptions)
nButLen := MAX(nButLen,LEN(aOptions[nI]))
NEXT
// Resize all buttons
FOR nI := 1 TO LEN(aOptions)
aOptions[nI] := PADC(aOptions[nI],nButLen)
NEXT
// Compute len of options to display
nOptLen := LEN(aOptions)*(nButLen+2)
// Compute box position
nWidth := MAX(nMessLen,nOptLen)+6+2+2+1
nHeight := 2+4+LEN(aMessage)
nTop := INT((MAXROW()+1-nHeight)/2)
nLeft := INT((MAXCOL()+1-nWidth)/2)
nOptLeft := INT((MAXCOL()+1-nOptLen)/2)+3
// Save screen under box
xSaveScr := SAVESCREEN(nTop,nLeft,nTop+nHeight,nLeft+nWidth)
// display 3D box
DISPBOX(nTop,nLeft,nTop+nHeight,nLeft+nWidth,LLG_BOX_GRAY_SQUARE)
// display Icon
IF xIcon<>NIL
IF xIcon ==MB_ICON_QUESTION
gBmpDisp(gBmpLoad("DIA_QUES.BMP") , (nLeft+4)*FONT_SIZE_X , (nTop+2)*FONT_SIZE_Y )
ELSEIF xIcon ==MB_ICON_EXCLAMATION
gBmpDisp(gBmpLoad("DIA_EXCL.BMP") , (nLeft+4)*FONT_SIZE_X , (nTop+2)*FONT_SIZE_Y )
ELSEIF xIcon ==MB_ICON_STOP
gBmpDisp(gBmpLoad("DIA_STOP.BMP") , (nLeft+4)*FONT_SIZE_X , (nTop+2)*FONT_SIZE_Y )
ELSEIF xIcon ==MB_ICON_INFO
gBmpDisp(gBmpLoad("DIA_INFO.BMP") , (nLeft+4)*FONT_SIZE_X , (nTop+2)*FONT_SIZE_Y )
ENDIF
ENDIF
// display Title
IF VALTYPE(cTitle)=='C'
gWriteAt( ( nLeft+INT((nWidth-LEN(cTitle))/2 ))* FONT_SIZE_X ,;
nTop * FONT_SIZE_Y ,;
cTitle ,;
1 ,;
LLG_MODE_SET ;
)
ENDIF
// Display message
FOR nI := 1 TO LEN(aMessage)
DEVPOS( nTop+1+nI, nLeft + 6 + INT( (nWidth-4-LEN(aMessage[nI]) ) /2 ) )
DEVOUT(aMessage[nI],"N/W+")
NEXT
// Compute each option location and create a button
nJ := nOptLeft + 1
FOR nI := 1 TO LEN(aOptions)
@ nJ * FONT_SIZE_X ,;
(nTop+nHeight-2) * FONT_SIZE_Y ,,;
BUTTON ;
STYLE BUTTON_TYPE_KEY ;
ACTION nI ;
ACCELERATOR LEFT(LTRIM(aOptions[nI]),1) ;
DISPLAYUP aOptions[nI] ;
ATTACH aWinButtons
nJ += LEN(aOptions[nI])+2
NEXT
// Show all buttons
SHOW ALL BUTTONS aWinButtons
DO WHILE !lExitAllowed // Loop while not exit requested
// Use mInkey() to manage buttons
nKey := mInkey(0,aWinButtons)
// Each button return a pseudo key from 1 to LEN(aOptions)
IF nKey>=1 .AND. nKey<=LEN(aOptions)
lExitAllowed := .T.
ENDIF
ENDDO
// Restore environnement values
mHide()
RESTSCREEN(nTop,nLeft,nTop+nHeight,nLeft+nWidth,xSaveScr)
DEVPOS(nSaveRow,nSaveCol)
SETCURSOR(nSaveCur)
RETURN (nKey)
*
// Group Video Modes
// Note : Here are some very simples
// CA-CLIPPER generics functions,
// to allow yo to manages video modes
/***
*
*
* WallPaper() Recover all the screen with a .BMP file
* nSetBestVideo() Look for the best video mode available in 16 or 256 colors
* aVideoModes() Grab all the video modes availables in 16 and 256 colors
* nChooseVideoMode() Grab all available video modes in VGA and VESA and lets
* the user choose the mode.
*
*/
*
FUNCTION WallPaper(cFileName)
// This function load the cFileName .BMP
// file and recover all the screen
// Get maximum graphics coordinates
LOCAL nNeedX := gMode()[LLG_MODE_GRAPH_COL]
LOCAL nNeedY := gMode()[LLG_MODE_GRAPH_ROW]
// Create a .BMP pointer
LOCAL aBmp := {}
// Indices
LOCAL nPaintX := 0
LOCAL nPaintY := 0
IF cFileName==NIL // Default to Marble.Bmp
cFileName := 'MARBLE.BMP'
ENDIF
// Load the defined filename
aBmp := gBmpLoad(cFileName)
IF !EMPTY(aBmp)
// If BMP have been loaded succesfully
DO WHILE nPaintY <= nNeedY
// While vertical filling not completed
DO WHILE nPaintX <= nNeedX
// While horizontal filling not completed
// Display BMP
gBmpDisp(aBmp,nPaintX,nPaintY)
// Move X coordinate by the length of .BMP
nPaintX += aBmp[LLG_BMP_X]
ENDDO
// Reset X coordinate
nPaintX := 0
// Move Y coordinate by the height of .BMP
nPaintY += aBmp[LLG_BMP_Y]
ENDDO
ENDIF
RETURN (NIL)
*
FUNCTION nSetBestVideo(nVideoParam ; // LLG_VIDEO_BEST_16 | LLG_VIDEO_BEST_256
)
// This function look for the best video mode
// available in 16 or 256 colors
LOCAL nBestMode := 0 // If no mode available, return 0
IF nVideoParam == LLG_VIDEO_BEST_16
// Check if 1280_1024_16 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_1280_1024_16))=='A'
nBestMode := LLG_VIDEO_VESA_1280_1024_16
ELSE
// Check if 1024_768_16 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_1024_768_16))=='A'
nBestMode := LLG_VIDEO_VESA_1024_768_16
ELSE
// Check if 800_592_16 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_800_592_16))=='A'
nBestMode := LLG_VIDEO_VESA_800_592_16
ELSE
// Check if 640_480_16 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VGA_640_480_16))
nBestMode := LLG_VIDEO_VGA_640_480_16
ENDIF
ENDIF
ENDIF
ENDIF
ELSEIF nVideoParam == LLG_VIDEO_BEST_256
// Check if 1280_1024_256 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_1280_1024_256))=='A'
nBestMode := LLG_VIDEO_VESA_1280_1024_256
ELSE
// Check if 1024_768_256 is supported
IF VALTYPE(-gMode(LLG_VIDEO_VESA_1024_768_256))=='A'
nBestMode := LLG_VIDEO_VESA_1024_768_256
ELSE
// Check if 800_592_256 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_800_592_256))=='A'
nBestMode := LLG_VIDEO_VESA_800_592_256
ELSE
// Check if 640_480_256 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_640_480_256))=='A'
nBestMode := LLG_VIDEO_VESA_640_480_256
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
RETURN (nBestMode)
*
FUNCTION aVideoModes()
// This function grab all the video modes
// availables in 16 and 256 colors
LOCAL aVideoMode := {}
// Check if 640_480_16 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VGA_640_480_16))=='A'
AADD(aVideoMode,LLG_VIDEO_VGA_640_480_16)
ENDIF
// Check if 800_592_16 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_800_592_16))=='A'
AADD(aVideoMode,LLG_VIDEO_VESA_800_592_16)
ENDIF
// Check if 1024_768_16 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_1024_768_16))=='A'
AADD(aVideoMode,LLG_VIDEO_VESA_1024_768_16)
ENDIF
// Check if 1280_1024_16 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_1280_1024_16))=='A'
AADD(aVideoMode,LLG_VIDEO_VESA_1280_1024_16)
ENDIF
// Check if 640_480_256 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_640_480_256))=='A'
AADD(aVideoMode,LLG_VIDEO_VESA_640_480_256)
ENDIF
// Check if 800_592_256 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_800_592_256))=='A'
AADD(aVideoMode,LLG_VIDEO_VESA_800_592_256)
ENDIF
// Check if 1024_768_256 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_1024_768_256))=='A'
AADD(aVideoMode,LLG_VIDEO_VESA_1024_768_256)
ENDIF
// Check if 1280_1024_256 is supported
IF VALTYPE(gMode(-LLG_VIDEO_VESA_1280_1024_256))=='A'
AADD(aVideoMode,LLG_VIDEO_VESA_1280_1024_256)
ENDIF
RETURN (aVideoMode)
*
FUNCTION nChooseVideoMode()
// This function use aVideoModes() to checks for
// all available video modes in VGA and VESA and
// lets the user choose the mode.
// This function does not set the mode the user
// choose
// It returns the value of the mode or 0 to abort
LOCAL nI := 0
LOCAL aI := {}
LOCAL aA := {}
LOCAL cA := ""
LOCAL aJ := { { LLG_VIDEO_VGA_640_480_16 , " 640 x 480 x 16" } ,;
{ LLG_VIDEO_VESA_800_592_16 , " 800 x 592 x 16" } ,;
{ LLG_VIDEO_VESA_1024_768_16 , " 1024 x 768 x 16" } ,;
{ LLG_VIDEO_VESA_1280_1024_16 , " 1280 x 1024 x 16" } ,;
{ LLG_VIDEO_VESA_640_480_256 , " 640 x 480 x 256" } ,;
{ LLG_VIDEO_VESA_800_592_256 , " 800 x 592 x 256" } ,;
{ LLG_VIDEO_VESA_1024_768_256 , " 1024 x 768 x 256" } ,;
{ LLG_VIDEO_VESA_1280_1024_256 , " 1280 x 1024 x 256" } ,;
}
aI := aVideoModes() // Collect video modes
IF LEN(aI)==0 // No graphics modes availables
nI := 0
ELSEIF LEN(aI)==1 // Only one graphics mode available, dont need
// to alert the user
nI := aI[1]
ELSE // More than one video mode available
// Construct an alert box
FOR nI := 1 TO LEN(aI)
cA += CHR(64+nI)+" : "+aJ[ASCAN(aJ,{|el| el[1]==aI[nI] }),2]+";"
AADD(aA,CHR(64+nI))
NEXT nI
nI:=ALERT(cA,aA) // Display alert box
IF nI<>0 // If user does not abort, retrieve mode from aI
nI := aI[nI]
ENDIF
ENDIF
RETURN (nI)
*
// Group Palette
// Note : Here are some very simples
// functions to allow palette and colors manipulations
// You should use or modify them if needed
/***
*
*
* ChgPalette() Change the colors palette
* nUsedColor() Color being changed
* nChangeColor() Change the components of a color
* ButPalColor() Draw a color button
* aPalSave() Save components of all colors
* aPalRest() Rest components of all colors
*
*/
*
FUNCTION ChgPalette()
// Change the colors palette
LOCAL nTop := 8 // Windows coordinates
LOCAL nLeft := 8
LOCAL nBottom := 18
LOCAL nRight := 75
// Old palette values to allow cancel
// Note we work on the first 16 colors
LOCAL aOldPalette := aPalSave(16)
// Save
LOCAL xSave := SAVESCREEN(nTop,nLeft,nBottom,nRight)
LOCAL aWinButtons := {} // Buttons handle
LOCAL nKey := 0 // Key handle
// Potentiometers handle
LOCAL aPalPoten := {{},{},{}}
// Block to EVAL when a component of a color
// is changed
LOCAL bPalBlock := { || gSetPal(nUsedColor(),nPotRed,nPotGre,nPotBlu) }
// Display a 3D box
DISPBOX(nTop,nLeft,nBottom,nRight,LLG_BOX_GRAY_SQUARE)
// Add a potentiometer to manage Red %
@ nLeft+4,nTop+2 WIDTH 25 ;
POTENTIOMETER ;
SETGET { |nVal| IF(nVal==NIL,nPotRed,nPotRed:=nVal) } ;
EXECUTE bPalBlock ;
RANGE 0,63 ;
PICTURE "999" ;
HANDLE aPalPoten[1] ;
ATTACH aWinButtons
// Add a potentiometer to manage Green %
@ nLeft+4,nTop+4 WIDTH 25 ;
POTENTIOMETER ;
SETGET { |nVal| IF(nVal==NIL,nPotGre,nPotGre:=nVal) } ;
EXECUTE bPalBlock ;
RANGE 0,63 ;
PICTURE "999" ;
HANDLE aPalPoten[2] ;
ATTACH aWinButtons
// Add a potentiometer to manage Blue %
@ nLeft+4,nTop+6 WIDTH 25 ;
POTENTIOMETER ;
SETGET { |nVal| IF(nVal==NIL,nPotBlu,nPotBlu:=nVal) } ;
EXECUTE bPalBlock ;
RANGE 0,63 ;
PICTURE "999" ;
HANDLE aPalPoten[3] ;
ATTACH aWinButtons
// Add a button for color 00
@ FONT_SIZE_X*(nLeft+02) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+06)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(00,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,00,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,00,.F.) } ;
ATTACH aWinButtons
// Add a button for color 01
@ FONT_SIZE_X*(nLeft+06) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+10)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(01,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,01,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,01,.F.) } ;
ATTACH aWinButtons
// Add a button for color 02
@ FONT_SIZE_X*(nLeft+10) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+14)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(02,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,02,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,02,.F.) } ;
ATTACH aWinButtons
// Add a button for color 03
@ FONT_SIZE_X*(nLeft+14) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+18)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(03,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,03,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,03,.F.) } ;
ATTACH aWinButtons
// Add a button for color 04
@ FONT_SIZE_X*(nLeft+18) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+22)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(04,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,04,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,04,.F.) } ;
ATTACH aWinButtons
// Add a button for color 05
@ FONT_SIZE_X*(nLeft+22) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+26)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(05,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,05,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,05,.F.) } ;
ATTACH aWinButtons
// Add a button for color 06
@ FONT_SIZE_X*(nLeft+26) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+30)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(06,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,06,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,06,.F.) } ;
ATTACH aWinButtons
// Add a button for color 07
@ FONT_SIZE_X*(nLeft+30) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+34)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(07,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,07,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,07,.F.) } ;
ATTACH aWinButtons
// Add a button for color 08
@ FONT_SIZE_X*(nLeft+34) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+38)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(08,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,08,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,08,.F.) } ;
ATTACH aWinButtons
// Add a button for color 09
@ FONT_SIZE_X*(nLeft+38) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+42)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(09,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,09,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,09,.F.) } ;
ATTACH aWinButtons
// Add a button for color 10
@ FONT_SIZE_X*(nLeft+42) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+46)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(10,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,10,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,10,.F.) } ;
ATTACH aWinButtons
// Add a button for color 11
@ FONT_SIZE_X*(nLeft+46) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+50)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(11,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,11,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,11,.F.) } ;
ATTACH aWinButtons
// Add a button for color 12
@ FONT_SIZE_X*(nLeft+50) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+54)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(12,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,12,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,12,.F.) } ;
ATTACH aWinButtons
// Add a button for color 13
@ FONT_SIZE_X*(nLeft+54) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+58)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(13,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,13,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,13,.F.) } ;
ATTACH aWinButtons
// Add a button for color 14
@ FONT_SIZE_X*(nLeft+58) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+62)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(14,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,14,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,14,.F.) } ;
ATTACH aWinButtons
// Add a button for color 15
@ FONT_SIZE_X*(nLeft+62) ,;
FONT_SIZE_Y*(nBottom-2) ,;
FONT_SIZE_X*(nLeft+66)-1 ,;
FONT_SIZE_Y*nBottom-1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { || nUsedColor(nChangeColor(15,aPalPoten,nLeft,nTop,nRight,nBottom)) } ;
DISPLAYUP { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,15,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB| ButPalColor(nL,nT,nR,nB,15,.F.) } ;
ATTACH aWinButtons
// Add a "CANCEL" button to emulate K_ESC
@ (nRight - 10) * FONT_SIZE_X ,;
(nTop + 2 ) * FONT_SIZE_Y ,,;
BUTTON ;
STYLE BUTTON_TYPE_KEY ;
ACTION K_ESC ;
ACCELERATOR K_ALT_L ;
DISPLAYUP gBmpLoad("CANCEL.BMU") ;
DISPLAYDN gBmpLoad("CANCEL.BMD") ;
ATTACH aWinButtons
// Add a "OK" button to emulate K_PGDN
@ (nRight - 10) * FONT_SIZE_X ,;
(nTop + 5 ) * FONT_SIZE_Y ,,;
BUTTON ;
STYLE BUTTON_TYPE_KEY ;
ACTION K_PGDN ;
ACCELERATOR K_ALT_O ;
DISPLAYUP gBmpLoad("OK.BMU") ;
DISPLAYDN gBmpLoad("OK.BMD") ;
ATTACH aWinButtons
// Display all buttons
ButtonShowAll(aWinButtons)
// Set the default color to 14
nUsedColor(nChangeColor(14,aPalPoten,nLeft,nTop,nRight,nBottom))
WHILE .T. // Repeat until user request EXIT
// Use mInkey() to manage key and buttons
nKey := mInkey(0,aWinButtons)
DO CASE
// IF Page Down, valid
CASE nKey == K_PGDN
EXIT
CASE nKey == K_ESC
// IF ESC, cancel
// Restore previously saved palette
aPalRest(aOldPalette)
// Reset Red/Green/Blue variables
nChangeColor(nUsedColor(),aPalPoten,nLeft,nTop,nRight,nBottom)
EXIT
ENDCASE
ENDDO
// Restore old screen
RESTSCREEN(nTop,nLeft,nBottom,nRight,xSave)
RETURN (NIL)
*
STATIC FUNCTION nUsedColor(nColor)
// Set Get function to manage color
// beeing changed
STATIC nColorInUse := 0
IF nColor<>NIL
nColorInUse := nColor
ENDIF
RETURN (nColorInUse)
*
STATIC FUNCTION nChangeColor(nColor ,; // Color to be used
aPalPoten ,; // Handle on potentiometers
nLeft ,; // Palette window area
nTop ,; //
nRight ,; //
nBottom ; //
)
// Change the components of a color
// Grab nColor palette components
LOCAL aPal := gSetPal(nColor)
// Display a frame
gFrame(FONT_SIZE_X*(nRight-37) ,;
FONT_SIZE_Y*(nTop+2) ,;
FONT_SIZE_X*(nRight-11)-1 ,;
FONT_SIZE_Y*(nBottom-3)-1 ,;
07 ,;
15 ,;
00 ,;
3, 3, 3, 3, LLG_MODE_SET ;
)
// Display the new color
gRect(FONT_SIZE_X*(nRight-37) +3 ,;
FONT_SIZE_Y*(nTop+2) +3 ,;
FONT_SIZE_X*(nRight-11)-1-3 ,;
FONT_SIZE_Y*(nBottom-3)-1-3 ,;
LLG_FILL ,;
nColor ,;
LLG_MODE_SET ;
)
// Reset/redisplay Red/Green/Blue variables
EVAL(ATAIL(aPalPoten[1]),nPotRed:=aPal[1])
EVAL(ATAIL(aPalPoten[2]),nPotGre:=aPal[2])
EVAL(ATAIL(aPalPoten[3]),nPotBlu:=aPal[3])
// Update potentiometers
ScrBarUpDate(aPalPoten[1],nPotRed/64)
ScrBarUpDate(aPalPoten[2],nPotGre/64)
ScrBarUpDate(aPalPoten[3],nPotBlu/64)
RETURN (nColor)
*
STATIC FUNCTION ButPalColor(nLeft ,; // Color button coordinates
nTop ,; //
nRight ,; //
nBottom ,; //
nColor ,; // Color to be displayed
lDisplayUp ; // Position up or down
)
// Draw a color button
// Display a frame
gFrame(nLeft ,;
nTop ,;
nRight ,;
nBottom ,;
07 ,;
IF(lDisplayUp,00,15) ,;
IF(lDisplayUp,15,00) ,;
3, 3, 3, 3, LLG_MODE_SET ;
)
// Display the color
gRect(nLeft+3 ,;
nTop+3 ,;
nRight-3 ,;
nBottom-3 ,;
LLG_FILL ,;
nColor ,;
LLG_MODE_SET ;
)
RETURN (NIL)
*
FUNCTION aPalSave(nFirstColors ; // Save only the n First Colors
)
// This function save all colors components
// in an array of arrays
LOCAL aPalStore := {}
LOCAL nI := 0
IF nFirstColors == NIL
nFirstColors := gMode()[LLG_MODE_COLOR_MAX]
ENDIF
// For all colors requested
FOR nI := 1 TO nFirstColors
// Save color reference and color components
AADD(aPalStore , { nI-1 ,;
gSetPal(nI-1)[1] ,;
gSetPal(nI-1)[2] ,;
gSetPal(nI-1)[3] ,;
} ;
)
NEXT nI
// Return an array or arrays
RETURN (aPalStore)
*
FUNCTION aPalRest(aPalette)
// This function set all colors components
// depending on values passed in an array
LOCAL nI := 0 // Loop indice
// For all the arrays in the major array
FOR nI := 1 TO LEN(aPalette)
// Reset the color components
gSetPal(aPalette[nI,1] ,;
aPalette[nI,2] ,;
aPalette[nI,3] ,;
aPalette[nI,4] ;
)
NEXT nI
RETURN (aPalette)
*
// Group Business graphic
// Note : Here are some very simples
// CA-CLIPPER generics functions.
// You should use or modify them if needed
/***
*
* BarGraph() Display a LINE/LINE_3D/BAR/BAR_3D graph
* DrawValue() Draw values from BarGraph()
* CirGraph() Display a pie graph
*
*/
*
FUNCTION BarGraph( nTop ,; // Top coordinates in rows
nleft ,; // Left coordinates in columns
nBottom ,; // Bottom coordinates in rows
nRight ,; // Left coordinates in columns
aValues ,; // List of values
nStyle ,; // Graph style (STYLE_BAR, STYLE_LINE, STYLE_BAR_3D, STYLE_LINE_3D)
nMin ,; // Vertical scale minimum value
nMax ; // Vertical scale maximum value
)
LOCAL aOldClip := {} // Previous Clipping region
LOCAL nI := 0 // Loop pointer
LOCAL nJ := 0 // Loop pointer
LOCAL nIncrement := 0 // Space beetween each value
LOCAL nMaxValue := 0 // Maximum value of data set
LOCAL nMinValue := 0 // Minimum value of data set
LOCAL nNbBar := 0 // Number of bars for each value
Local nBarWidth := 0 // Bar width
LOCAL nGraphTop := (nTop * FONT_SIZE_Y + 20) // Top limit of graph area
LOCAL nGraphleft := (nLeft * FONT_SIZE_X + 16 +10 ) // Left ""
LOCAL nGraphBottom := (nBottom * FONT_SIZE_Y - 20) // Bottom ""
LOCAL nGraphRight := (nRight * FONT_SIZE_X - 16 -10) // Right ""
LOCAL nXPosition := nGraphBottom // Position of X axis
LOCAL nXAxisColor := 4 // Color of X axis
LOCAL nYPosition := nGraphLeft // Position of Y axis
LOCAL nYAxisColor := 3 // Color of Y axis
LOCAL nGraphWidth := nGraphRight - nGraphLeft // Graph width
LOCAL nGraphHeight := nGraphBottom - nGraphTop // Graph height
LOCAL nYlegLen := 0 // Length of Y axis legend
LOCAL nXLegLen := 0 // Total Length of X axis legend
LOCAL nXLegNbLine := 0 // Number of lines of X axis legend
// Compute Maximum and Minimum values
FOR nI := 1 TO LEN(aValues)
FOR nJ := 2 TO LEN(aValues[nI])
nMaxValue := MAX( aValues[nI,nJ], nMaxValue )
nMinValue := MIN( aValues[nI,nJ], nMinValue )
NEXT
// Compute maximum number of bars
nNbBar := MAX(nNbBar,LEN(aValues[nI])-1)
// Total lentgh of X axis legends
nXLegLen := nXLegLen + LEN(aValues[nI,1]) + 1
NEXT
// Round minimum and maximum values
nMaxValue := nRoundSup(nMaxValue)
nMinValue := nRoundSup(nMinValue)
// If maximum and minimum values have been
// defined replace nMinValue and nMaxValue
IF nMin <> NIL
nMinValue := nMin
ENDIF
IF nMax <> NIL
nMaxValue := nMax
ENDIF
// Length of Y axis legend is max of
// minimum value length and maximum value length
nYLegLen := MAX( LEN(ALLTRIM(STR(nMaxValue))), ;
LEN(ALLTRIM(STR(nMinValue))))
// Y axis position
nYPosition := nGraphLeft + nYLegLen * FONT_SIZE_X
// Maximum graph width
nGraphWidth := nGraphRight - nYPosition
// Increment to move bars
nIncrement := nGraphWidth / LEN(aValues)
// Bars width
nBarWidth := nIncrement / nNbBar
// Number of X axis legend lines
nXLegNbLine := INT( nXLegLen * FONT_SIZE_X / nGraphWidth )
IF nXLegNbLine < nXLegLen * FONT_SIZE_X / nGraphWidth
nXLegNbLine := nXLegNbLine + 1
ENDIF
// Correct graph Height
nGraphHeight := nGraphHeight - nXLegNbLine * FONT_SIZE_Y
// Correct graph bottom position
nGraphBottom := nGraphBottom - nXLegNbLine * FONT_SIZE_Y
// X axis position
nXPosition := nGraphBottom - ABS( nMinValue / (nMaxValue-nMinValue) ) * nGraphHeight
// Define clipping region to avoid
// writing outside graph
aOldClip := gSetClip( nLeft * FONT_SIZE_X ,;
nTop * FONT_SIZE_Y ,;
nRight * FONT_SIZE_X ,;
nBottom * FONT_SIZE_Y ;
)
// Draw box arround graph
gFrame( nLeft * FONT_SIZE_X ,;
nTop * FONT_SIZE_Y ,;
nRight * FONT_SIZE_X - 1 ,;
nBottom * FONT_SIZE_Y - 1 ,;
7, 15, 8 ,;
5, 5, 5, 5 ,;
LLG_MODE_SET ;
)
// Draw horizontal axis
gLine( nYPosition ,;
nXPosition ,;
nGraphRight ,;
nXPosition ,;
nXAxisColor ,;
LLG_MODE_SET ;
)
// Draw vertical axis
gLine( nYPosition ,;
nGraphTop ,;
nYPosition ,;
nGraphBottom ,;
nYAxisColor ,;
LLG_MODE_SET ;
)
// Place 10 standard values on Y Axis
FOR nI := nMinValue TO nMaxValue STEP ABS( (nMinValue-nMaxValue) / 10)
gWriteAt( nGraphLeft - FONT_SIZE_X ,;
nXPosition - nI / ABS( nMinValue - nMaxValue)*nGraphHeight -FONT_SIZE_X ,;
STR(nI,nYLegLen) + "-" ,;
nYAxisColor ,;
LLG_MODE_SET ;
)
NEXT nI
DrawValue() // Reset static variables
// keeping previous values
// Draw values
FOR nI := 0 TO LEN(aValues) - 1
// Draw bars or a lines for each X value
FOR nJ := 0 TO nNbBar-1
DrawValue( nYPosition + ( nI * nIncrement ) + ;
IF( nStyle == STYLE_BAR .OR. nStyle == STYLE_BAR_3D ,;
nJ*nBarWidth ,;
0 ;
) ,;
nXPosition ,;
nBarWidth ,;
aValues[nI+1,nJ+2] / ABS( nMinValue - nMaxValue)*nGraphHeight ,;
nJ+2 ,;
nStyle ;
)
NEXT nJ
// Write legends on X axis only for first pass
gWriteAt(nYPosition + nI * nIncrement ,;
nGraphBottom + (nI % nXLegNbLine ) * FONT_SIZE_Y + 2 ,;
aValues[nI+1,1] ,;
nXAxisColor ,;
LLG_MODE_SET ;
)
gLine( nYPosition + nI * nIncrement ,;
nXPosition ,;
nYPosition + nI * nIncrement ,;
nXPosition + 3 ,;
nXAxisColor ,;
LLG_MODE_SET ;
)
NEXT nI
// Reset previous clipping area
gSetClip( aOldClip[1] ,;
aOldClip[2] ,;
aOldClip[3] ,;
aOldClip[4] ;
)
RETURN (NIL)
*
FUNCTION DrawValue( nLeft ,; // Left coordinates in pixels
nTop ,; // Top coordinates in pixels
nWidth ,; // Width in pixels
nHeight ,; // Height in pixels
nColor ,; // Color
nStyle ; // Style
)
STATIC aPrevCoord := {} // Coordinates of previous drawn values
LOCAL nI := 0 // Loop pointer
LOCAL nPointer := 0 // ASCAN pointer
LOCAL nDepth := 0 // Depth of 3D graphs
IF nStyle == NIL // No parameters => reset aPrevCoord
nStyle := 99
ELSEIF nStyle == STYLE_BAR_3D .OR. nStyle == STYLE_LINE_3D
// 3D graph, define depth
nDepth := MIN(nWidth/4,10)
ELSE
// depth = 0
nDepth := 0
ENDIF
// Style BARGRAPH
IF nStyle == STYLE_BAR .OR. nStyle == STYLE_BAR_3D
// Depth no null 3D bars
IF nDepth > 0
// Fill background whith gray for 3D bar
FOR nI := 1 TO nDepth
gRect( nLeft + nI ,;
nTop - nI ,;
nLeft + nWidth + nI ,;
nTop - nHeight - nI ,;
LLG_FRAME ,;
8 ,;
LLG_MODE_SET ;
)
NEXT nI
// Draw 3D bar depth lines
gLine( nLeft ,;
nTop ,;
nLeft + nDepth ,;
nTop - nDepth ,;
4 ,;
LLG_MODE_SET ;
)
gLine( nLeft ,;
nTop - nHeight ,;
nLeft + nDepth ,;
nTop - nHeight - nDepth ,;
4 ,;
LLG_MODE_SET ;
)
gLine( nLeft + nWidth ,;
nTop ,;
nLeft + nWidth + nDepth ,;
nTop - nDepth ,;
4 ,;
LLG_MODE_SET ;
)
gLine( nLeft + nWidth ,;
nTop - nHeight ,;
nLeft + nWidth + nDepth ,;
nTop - nHeight - nDepth ,;
4 ,;
LLG_MODE_SET ;
)
// Draw frame arround background
gRect( nLeft + nDepth ,;
nTop - nDepth ,;
nLeft + nWidth + nDepth ,;
nTop - nHeight - nDepth ,;
LLG_FRAME ,;
4 ,;
LLG_MODE_SET ;
)
ENDIF
// Draw front colored bar
gRect( nLeft ,;
nTop ,;
nLeft + nWidth ,;
nTop - nHeight ,;
LLG_FILL ,;
nColor ,;
LLG_MODE_SET ;
)
// Draw frame arround colored bar
gRect( nLeft ,;
nTop ,;
nLeft + nWidth ,;
nTop - nHeight ,;
LLG_FRAME ,;
4 ,;
LLG_MODE_SET ;
)
// Style LINEGRAPH
ELSEIF nStyle == STYLE_LINE .OR. nStyle == STYLE_LINE_3D
IF nDepth == 0
// Draw cross arround point location
// with two lines
gLine( nLeft - 2 ,;
nTop - nHeight-2 ,;
nLeft + 2 ,;
nTop - nHeight + 2 ,;
nColor ,;
LLG_MODE_SET ;
)
gLine( nLeft + 2 ,;
nTop - nHeight - 2 ,;
nLeft - 2 ,;
nTop - nHeight + 2 ,;
nColor ,;
LLG_MODE_SET ;
)
ENDIF
// Locate coordinates of previous point
// with same color
nPointer := ASCAN(aPrevCoord, { |aElem| aElem[1] == nColor })
// Previous point found
IF nPointer <> 0
FOR nI := 0 TO nDepth
// Draw line between previous point
// and current point
gLine( aPrevCoord[nPointer ,2]+nI ,;
aPrevCoord[nPointer ,3]-nI ,;
nLeft + nI ,;
nTop - nHeight - nI ,;
nColor ,;
LLG_MODE_SET ;
)
NEXT nI
ELSE // Previous point not found
// (first point)
// Add an element to coordinates array
// for current color
AADD(aPrevCoord,{nColor,NIL,NIL})
nPointer := LEN(aPrevCoord)
ENDIF
// Store current point coordinates for next point
aPrevCoord[nPointer ,2] := nLeft
aPrevCoord[nPointer ,3] := nTop - nHeight
ELSE // Style not bar, not line
// reset coordinates array
aPrevCoord := {}
ENDIF
RETURN (NIL)
*
FUNCTION CirGraph( nTop ,; // Top coordinates in rows
nleft ,; // Left coordinates in columns
nBottom ,; // Bottom coordinates in rows
nRight ,; // Right coordinates in columns
aValues ; // Array of values
)
LOCAL aOldClip := {} // Previous Clipping region
LOCAL nI := 0 // Loop pointer
LOCAL nJ := 0 // Loop pointer
LOCAL nGraphTop := (nTop * FONT_SIZE_Y + 20) // Top limit of graph area
LOCAL nGraphleft := (nLeft * FONT_SIZE_X + 16 +10 ) // Left ""
LOCAL nGraphBottom := (nBottom * FONT_SIZE_Y - 20) // Bottom ""
LOCAL nGraphRight := (nRight * FONT_SIZE_X - 16 -10) // Right ""
// Center of Ellipse
LOCAL nXCenter := nGraphLeft + ( nGraphRight - nGraphLeft )/2
LOCAL nYCenter := nGraphTop + ( nGraphBottom - nGraphTop )/2
LOCAL nXSize := ( nGraphRight - nGraphLeft )/2
LOCAL nYSize := nXSize / 3
LOCAL nTotal := 0 // Sum of all values == 100%
LOCAL nAngleBeg := 0 // Begining of sector
LOCAL nAngleEnd := 0 // End of sector
// Define clipping region to avoid
// writing outside graph
aOldClip := gSetClip( nLeft * FONT_SIZE_X ,;
nTop * FONT_SIZE_Y ,;
nRight * FONT_SIZE_X ,;
nBottom * FONT_SIZE_Y ;
)
// Draw box arround graph
gFrame( nLeft * FONT_SIZE_X ,;
nTop * FONT_SIZE_Y ,;
nRight * FONT_SIZE_X - 1 ,;
nBottom * FONT_SIZE_Y - 1 ,;
7, 15, 8 ,;
5, 5, 5, 5 ,;
LLG_MODE_SET ;
)
// Compute sum of values to display
FOR nI := 1 TO LEN(aValues)
nTotal += aValues[nI,2]
NEXT
// Draw values
FOR nI := 1 TO LEN(aValues)
// Compute percentage
nAngleEnd := nAngleBeg + INT(360 * aValues[nI,2]/nTotal)
IF nI==LEN(aValues) // Force last value to 360
nAngleEnd := 360
ENDIF
// Draw part of ellipse
gEllipse( nXCenter ,;
nYCenter ,;
nXSize ,;
nYSize ,;
nAngleBeg ,;
nAngleEnd ,;
LLG_FILL ,;
IF(nI==7,2,nI),;
LLG_MODE_SET ;
)
// Next sector begining is current sector end
nAngleBeg := nAngleEnd
NEXT nI
// Reset Clipping region
gSetClip( aOldClip[1] ,;
aOldClip[2] ,;
aOldClip[3] ,;
aOldClip[4] ;
)
RETURN (NIL)
*
STATIC FUNCTION nRoundSup( nValue )
LOCAL nReturn := 0 // Return value
// Sign of value
LOCAL nSign := INT( nValue/ABS(nValue) )
// Length of value
LOCAL nValLen := LEN( ALLTRIM( STR( INT( nSign * nValue ) ) ) )
LOCAL nTmpVal := 0 // Temp Value
LOCAL nNearest := 0 // Nearest rounded value of nValue
// First rounds value
// 855 => 900
// 820 => 800
nNearest := ROUND( nSign * nValue, -nValLen + 1)
// Keep nearest value
nReturn := nNearest
nTmpVal := nValue
DO WHILE nSign * nValue > nReturn
// If value > rounded value,
// then try rounding a greater value
// Loop #1 820 * 820 / 800 = 840.5 => 800
// Loop #2 840 * 840 / 800 = 882 => 900
nTmpVal := nTmpVal*nTmpVal / nNearest
nReturn := ROUND(nTmpVal,-nValLen+1 )
ENDDO
RETURN (nSign * nReturn)
*
// Group Menu To
// Note : Here are some CA-CLIPPER
// modified functions to allow mouse
// and graphics use of Menu To
// Do not change them until you want to change
// the behaviour of MENU TO
/***
*
* @ ...,... PROMPT ... MESSAGE ... / MENU TO
*
* Standard MENU TO replacement system
*
*/
*
#DEFINE n_Prompt_Row 1
#DEFINE n_Prompt_Col 2
#DEFINE n_Prompt_Col_End 3
#DEFINE c_Prompt_Item 4
#DEFINE c_Prompt_Msg 5
#DEFINE c_Prompt_Key 6
*
FUNCTION __AtPrompt(nRow,nCol,cPrompt,cMsg)
AADD(aPrompt , { nRow ,;
nCol ,;
nCol+LEN(cPrompt)-1 ,;
cPrompt ,;
cMsg ,;
UPPER(LEFT(cPrompt+" ",1)) ;
} ;
)
DEVPOS(nRow,nCol)
DEVOUT(cPrompt)
RETURN (NIL)
*
FUNCTION __MenuTo(bChoice,cVarName)
LOCAL nChoice := 1
LOCAL nChoOld := 1
LOCAL nI := 0
LOCAL nKey := 0
LOCAL aState := LLM_INIT_STATE
LOCAL lExitRequested := .F.
LOCAL lNeedRefresh := .F.
LOCAL lNoEvent := .T.
LOCAL nSaveRow := ROW()
LOCAL nSaveCol := COL()
LOCAL nSaveCur := SETCURSOR()
LOCAL cSaveColor := SETCOLOR()
LOCAL cColorHig := ""
LOCAL lWrapMode := Set( _SET_WRAP )
LOCAL aLocalPrompt := {}
nChoice := EVAL(bChoice,1)
IF LEN(aPrompt)==0
RETURN (0)
ENDIF
nChoice := IF(nChoice>0 .AND. nChoice<=LEN(aPrompt),nChoice,1)
cColorHig := RIGHT(cSaveColor,LEN(cSaveColor)-AT(",",cSaveColor+","))
cColorHig := LEFT(cColorHig,AT(",",cColorHig)-1)
SETCURSOR(0)
__MenuToMsg(aPrompt[nChoice,c_Prompt_Msg])
SETCOLOR(cColorHig)
DEVPOS(aPrompt[nChoice,n_Prompt_Row],aPrompt[nChoice,n_Prompt_Col])
DEVOUT(aPrompt[nChoice,c_Prompt_Item])
SETCOLOR(cSaveColor)
mShow()
aState := LLM_INIT_STATE
lExitRequested := .F.
DO WHILE !lExitRequested
lNoEvent := .T.
DO WHILE lNoEvent
IF (nKey:=INKEY())<>0
IF ( SETKEY(nKey)<>NIL )
aLocalPrompt := ACLONE(aPrompt)
aPrompt := {}
EVAL( SETKEY(nKey) ,PROCNAME(1),PROCLINE(1),cVarName )
aPrompt := ACLONE(aLocalPrompt)
LOOP
ENDIF
lNoEvent := .F.
ELSE
aState:=mState()
IF aState[LLM_STATE_LEFT]==LLM_BUTTON_DOWN .OR. aState[LLM_STATE_RIGHT]==LLM_BUTTON_DOWN
lNoEvent := .F.
ENDIF
ENDIF
ENDDO
lNeedRefresh := .F.
DO CASE
CASE nKey==K_ESC .OR. nKey==K_ENTER
lExitRequested := .T.
CASE nKey==K_LEFT .OR. nKey==K_UP
lNeedRefresh := .T.
nChoice -= 1
IF nChoice==0
IF lWrapMode
nChoice := LEN(aPrompt)
ELSE
nChoice := 1
ENDIF
ENDIF
CASE nKey==K_RIGHT .OR. nKey==K_DOWN
lNeedRefresh := .T.
nChoice += 1
IF nChoice==LEN(aPrompt)+1
IF lWrapMode
nChoice := 1
ELSE
nChoice := LEN(aPrompt)
ENDIF
ENDIF
CASE aState[LLM_STATE_RIGHT]==LLM_BUTTON_DOWN
lExitRequested := .T.
CASE aState[LLM_STATE_LEFT]==LLM_BUTTON_DOWN
lExitRequested := .F.
FOR nI := 1 TO LEN(aPrompt)
IF aState[LLM_STATE_ROW]==aPrompt[nI,n_Prompt_Row] .AND. ;
aState[LLM_STATE_COL]>=aPrompt[nI,n_Prompt_Col] .AND. ;
aState[LLM_STATE_COL]<=aPrompt[nI,n_Prompt_Col_End]
nChoice := nI
lNeedRefresh := .T.
lExitRequested := .T.
EXIT
ENDIF
NEXT
IF !lExitRequested
nChoice := nChoOld
ENDIF
OTHERWISE
IF nKey<>0
nChoice := ASCAN(aPrompt,{|el| el[c_Prompt_Key]==UPPER(CHR(nKey)) })
IF nChoice <> 0
lNeedRefresh := .T.
lExitRequested := .T.
ELSE
nChoice := nChoOld
ENDIF
ENDIF
ENDCASE
mHide()
IF lNeedRefresh
DEVPOS(aPrompt[nChoOld,n_Prompt_Row],aPrompt[nChoOld,n_Prompt_Col])
DEVOUT(aPrompt[nChoOld,c_Prompt_Item])
__MenuToMsg(aPrompt[nChoice,c_Prompt_Msg])
SETCOLOR(cColorHig)
DEVPOS(aPrompt[nChoice,n_Prompt_Row],aPrompt[nChoice,n_Prompt_Col])
DEVOUT(aPrompt[nChoice,c_Prompt_Item])
SETCOLOR(cSaveColor)
nChoOld := nChoice
ENDIF
mShow()
ENDDO
IF nKey==K_ESC .OR. aState[LLM_STATE_RIGHT]==LLM_BUTTON_DOWN
nChoice := 0
ENDIF
mHide()
DEVPOS(nSaveRow,nSaveCol)
SETCURSOR(nSaveCur)
SETCOLOR(cSaveColor)
aPrompt := {}
RETURN (nChoice)
*
FUNCTION __MenuToMsg(cMsg)
STATIC cOldMsg := ""
STATIC nOldRow := 0
STATIC nOldCol := 0
DEVPOS(nOldRow,nOldCol)
DEVOUT(SPACE(LEN(cOldMsg)))
cOldMsg := cMsg
nOldRow := Set( _SET_MESSAGE )
IF Set( _SET_MCENTER )
nOldCol := INT( (MAXCOL()-LEN(cMsg))/2 )
ELSE
nOldCol := 0
ENDIF
DEVPOS(nOldRow,nOldCol)
DEVOUT(cOldMsg)
RETURN (NIL)
*
// Group Extended Gets - CHECK GETS
// Note : Here are some very simples
// CA-CLIPPER generics functions to extend
// GET/READ capability
/***
*
* ChkAddGet() Add a checkbox Get
* ChkGetReader() Special reader for checkbox Get
* ChkGetApplyKey() Checkbox Get apply key
* ChkButDisp() Display the checkbox button
* ChkOnOff() Switch chkbox button state
*
*/
*
FUNCTION ChkAddGet(bSetGetVar ,; // Set Get block on master variable
cVarName ,; // Variable name
aGetList ,; // Related gets
aCtrlButtons ,; // Related buttons
cSayExp ; // Expression
)
// Add a check box Get
LOCAL oGet // Temporary get object
// Cursor location
LOCAL nRow := ROW()
LOCAL nCol := COL()
LOCAL cI := '' // Temporary
// Create a new empty GET object
oGet := GETNEW(nRow,nCol+2,bSetGetVar,cVarName)
// Add it to the Get List
AADD(aGetList,oGet)
// Set the reader to the ChkReader
oGet:reader := { |oG,GetList,aButtons| ChkGetReader(oG,GetList,aButtons) }
// Use cargo to store Say Expression
oGet:cargo := { cSayExp, '' , '' }
// Use some translate to make it clearer
#XTRANSLATE :cSayExp => :cargo\[1\]
#XTRANSLATE :cUnselCol => :cargo\[2\]
#XTRANSLATE :cSelecCol => :cargo\[3\]
// Extract selected color from colorstring
cI := SETCOLOR()
cI := RIGHT(cI,LEN(cI)-AT(',',cI))
oGet:cSelecCol := LEFT(cI,AT(',',cI)-1)
// Extract unselected color from colorstring
cI := SETCOLOR()
oGet:cUnselCol := RIGHT(cI,LEN(cI)-RAT(',',cI))
DEVPOS(oGet:row,oGet:col)
DEVOUT(oGet:cSayExp,oGet:cUnselCol)
// Add a button to manage radio
@ FONT_SIZE_X * (oGet:col - 2 ) ,;
FONT_SIZE_Y * oGet:row ,;
FONT_SIZE_X * oGet:col - 1 ,;
FONT_SIZE_Y * ( oGet:row + 1 ) - 1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { |x,y,aButton| ChkOnOff(x,y,aButton,aGetList) } ;
DISPLAYUP { |nL,nT,nR,nB,xCargo| ChkButDisp(oGet,.T.) } ;
DISPLAYDN { |nL,nT,nR,nB,xCargo| ChkButDisp(oGet,.F.) } ;
CARGO LEN(aGetList) ;
ATTACH aCtrlButtons
RETURN (oGet)
*
FUNCTION ChkGetReader(oGet ,; // Object to be read
aGetList ,; // Related gets objects
aCtrlButtons ; // Related buttons
)
// Special reader for checkbox Get
// Needs some variables to manage Mouse and buttons
LOCAL nKey
LOCAL nCurrentGet
// Record reference of current get in GetList
nCurrentGet := Ascan(aGetList, {|o| o==oGet })
// If needed, reach the requested get
IF !(nHitGet()==NIL) .AND. nCurrentGet<>nHitGet()
IF nCurrentGet > nHitGet()
oGet:exitstate := GE_UP
ELSE
oGet:exitstate := GE_DOWN
ENDIF
ELSE
// Reset GetGoTo Set/Get function
nHitGet(NIL)
// Read the GET if the WHEN condition is satisfied
IF ( GetPreValidate( oGet ) )
// Do not give focus to this get, in this case
// it will display the value
// Display the SayExpr instead of the get value
DEVPOS(oGet:row,oGet:col)
DEVOUT(oGet:cSayExp,oGet:cSelecCol)
// Reset cursor position
DEVPOS(oGet:row,oGet:col)
WHILE ( oGet:exitState == GE_NOEXIT )
// Apply keystrokes until exit
WHILE ( oGet:exitState == GE_NOEXIT )
nKey := mInkey( 0 ,aCtrlButtons ,aGetList )
IF nKey == K_BUTTON .OR. nKey == K_ACCELERATOR
// Nothing To do
ELSEIF nKey == K_GET
IF nCurrentGet > nHitGet()
// Get field clicked is up
oGet:exitState := GE_UP
ELSEIF nCurrentGet < nHitGet()
// Get field clicked is down
oGet:exitState := GE_DOWN
ENDIF
ELSE
// Apply the key to the get object
ChkGetApplyKey( oGet, nKey )
ENDIF
ENDDO
// Disallow exit if the VALID condition
// is not satisfied
IF ( !GetPostValidate( oGet ) )
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
// Display the SayExpr instead of the get value
DEVPOS(oGet:row,oGet:col)
DEVOUT(oGet:cSayExp,oGet:cUnselCol)
// Reset cursor position
DEVPOS(oGet:row,oGet:col)
ENDIF
ENDIF
RETURN (NIL)
*
FUNCTION ChkGetApplyKey(oGet ,; // Get object
nKey ,; // Key number
aGetList ; // List of related gets
)
// Checkbox Get apply key
LOCAL bKeyBlock
// Check for SET KEY first
IF ( (bKeyBlock := SetKey(nKey)) <> NIL )
GetDoSetKey(bKeyBlock, oGet)
RETURN(NIL)
ENDIF
DO CASE
CASE ( nKey == K_UP )
oGet:exitState := GE_UP
CASE ( nKey == K_SH_TAB )
oGet:exitState := GE_UP
CASE ( nKey == K_DOWN )
oGet:exitState := GE_DOWN
CASE ( nKey == K_TAB )
oGet:exitState := GE_DOWN
CASE ( nKey == K_ENTER )
oGet:exitState := GE_ENTER
CASE ( nKey == 32 ) // use space bar to toggle the chkbox button
// change .T. in .F. or .F. in .T.
oGet:varput(!oGet:varget())
// redisplay check box button
ChkButDisplay( oGet , .T. )
CASE ( nKey == K_ESC )
IF ( SET(_SET_ESCAPE) )
oGet:undo()
oGet:exitState := GE_ESCAPE
ENDIF
CASE ( nKey == K_PGUP )
oGet:exitState := GE_WRITE
CASE ( nKey == K_PGDN )
oGet:exitState := GE_WRITE
CASE ( nKey == K_CTRL_HOME )
oGet:exitState := GE_TOP
CASE (nKey == K_CTRL_W)
oGet:exitState := GE_WRITE
CASE (nKey == K_INS)
SET( _SET_INSERT, !SET(_SET_INSERT) )
ShowScoreboard()
ENDCASE
RETURN (NIL)
*
FUNCTION ChkButDisp(oGet ,; // Get object
lDisplayUp ; // Display in up or down position
)
// Display the checkbox button
IF oGet:varget()
// If the get is selected
gBmpDisp(IF(lDisplayUp,aBmpBase[CHECK_F_UP],aBmpBase[CHECK_F_DW]),;
FONT_SIZE_X * (oGet:col - 2 ) ,;
FONT_SIZE_Y * oGet:row ;
)
ELSE // If the get is not selected
gBmpDisp(IF(lDisplayUp,aBmpBase[CHECK_E_UP],aBmpBase[CHECK_E_DW]),;
FONT_SIZE_X * (oGet:col - 2 ) ,;
FONT_SIZE_Y * oGet:row ;
)
ENDIF
RETURN (NIL)
*
FUNCTION ChkOnOff(nMouseX ,; // Mouse pixels locations
nMouseY ,; //
aButton ,; // Pointer on the button
aGetList ; // List of related get
)
// Switch chkbox button state
// Retrieve the get object using button cargo
// which contains the number of the get in the
// list
LOCAL oGet := aGetList[aButton[BUTTON_CARGO]]
oGet:varput(!oGet:varget())
ChkButDisplay( oGet , .T. )
RETURN (NIL)
*
// Group Extended Gets - INCREMENTAL GETS
// Note : Here are some very simples
// CA-CLIPPER generics functions to extend
// GET/READ capability
/***
*
* IncreGetReader() Special reader for incremental Get
* IncrGetApplyKey() Incremental Get apply key for + and - keys
* IncreButton() Define a button to allow incremental action on a get
* IncreVal() Action to be executed when incremental button is down
*
*/
*
FUNCTION IncrGetReader(oGet ,; // Object to be read
aGetList ,; // Related gets objects
aCtrlButtons ; // Related buttons
)
// Special reader for incremental Get
// Needs some variables to manage Mouse and buttons
LOCAL nKey
LOCAL nCurrentGet
// Record reference of current get in GetList
nCurrentGet := Ascan(aGetList, {|o| o==oGet })
// If needed, reach the requested get
IF !(nHitGet()==NIL) .AND. nCurrentGet<>nHitGet()
IF nCurrentGet > nHitGet()
oGet:exitstate := GE_UP
ELSE
oGet:exitstate := GE_DOWN
ENDIF
ELSE
// Reset GetGoTo Set/Get function
nHitGet(NIL)
// Read the GET if the WHEN condition is satisfied
IF ( GetPreValidate( oGet ) )
// Activate the GET for reading
oGet:setFocus()
WHILE ( oGet:exitState == GE_NOEXIT )
// Check for initial typeout (no editable positions)
IF ( oGet:typeOut )
oGet:exitState := GE_ENTER
ENDIF
// Apply keystrokes until exit
WHILE ( oGet:exitState == GE_NOEXIT )
nKey := mInkey( 0 ,aCtrlButtons ,aGetList )
IF nKey == K_BUTTON .OR. nKey == K_ACCELERATOR
// Nothing To do
ELSEIF nKey == K_GET
IF nCurrentGet > nHitGet()
// Get field clicked is up
oGet:exitState := GE_UP
ELSEIF nCurrentGet < nHitGet()
// Get field clicked is down
oGet:exitState := GE_DOWN
ENDIF
ELSE
// Apply the key to the get object
IncrGetApplyKey( oGet, nKey )
ENDIF
ENDDO
// Disallow exit if the VALID condition
// is not satisfied
IF ( !GetPostValidate( oGet ) )
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
oGet:killFocus() // De-activate the GET
ENDIF
ENDIF
RETURN (NIL)
*
FUNCTION IncrGetApplyKey(oGet ,; // Get object
nKey ; // Key to be applied
)
// Incremental Get apply key for + and - keys
LOCAL xValue // Temporary value
DO CASE
CASE nKey == 43 // + Key
IF oGet:type$'ND' // Applicable only on numerics and dates gets
// Grab value from edit buffer
xValue := oGet:unTransform()
xValue++ // Increment
// Tansform, track change, display new value
oGet:buffer := TRANSFORM(xValue,oGet:picture)
oGet:changed := .T.
oGet:display()
ENDIF
CASE nKey == 45 // - key
IF oGet:type$'ND' // Applicable only on numerics and dates gets
// Grab value from edit buffer
xValue := oGet:unTransform()
xValue-- // Decrement
// Tansform, track change, display new value
oGet:buffer := TRANSFORM(xValue,oGet:picture)
oGet:changed := .T.
oGet:display()
ENDIF
OTHERWISE
// For all other key, use standard GetApplyKey()
GetApplyKey(oGet,nKey)
ENDCASE
RETURN (NIL)
*
FUNCTION IncreButton(oGet ,; // Get linked to the incremental button
aWinButtons ,; // List of related buttons
aGetList ; // List of related gets
)
// Add a button to manage incremental action
@ FONT_SIZE_X * COL() ,;
FONT_SIZE_Y * ROW() ,,;
BUTTON ;
STYLE BUTTON_TYPE_REPEAT ;
ACTION { |x,y,but| IncreVal(x,y,but,oGet) } ;
DISPLAYUP aBmpBase[ARROW_G_UP] ;
DISPLAYDN aBmpBase[ARROW_G_DW] ;
CARGO aGetList ;
ATTACH aWinButtons
RETURN (NIL)
*
STATIC FUNCTION IncreVal(nMouseX ,;
nMouseY ,;
aButton ,;
oGet ;
)
// This function is called by the incremental button
// from a get. You must note two things. 1st, the
// get linked to this button is not always the focused
// get, so we must work on the variable and not on
// the buffer, 2nd, as the button must be a repeat
// button we dont give the hand back to the reader so
// we must manage prevalidation and postvalidation
// at this level
LOCAL nRow := 0 // Define some environnement variables
LOCAL nCol := 0
LOCAL nSaveCur := 0
LOCAL xOldVal := 0 // Previous value to restore if needed
LOCAL xVal := 0 // Value to be incremented
// Allow modifications only when Get type is N or D;
// and when clause, if exists, is .T.
IF (oGet:type$'ND') .AND. ( oGet:preBlock == NIL ) .OR. EVAL( oGet:preBlock, oGet )
nRow := ROW() // Save cursor shape and location
nCol := COL()
nSaveCur := SETCURSOR(0)
// If get is focused
IF oGet:hasfocus
// Work on the buffer
xOldVal := oGet:UnTransform()
ELSE
// Else work on the variable
xOldVal := oGet:varget()
ENDIF
xVal := xOldVal // Store for futur value
// Add or substract depending on clic location
// on the top of button add 1, on the bottom
// substact 1
xVal += IF((oGet:row+0.5)*FONT_SIZE_Y<nMouseY,-1,1)
oGet:varput(xVal) // Store the new value in the variable
// Set variable value if valid clause, when
// exist, is .T.
IF !( oGet:postBlock == NIL ) .AND. !EVAL( oGet:postBlock, oGet )
// Valid clause is .F., restore old value
oGet:varput(xOldVal)
ELSE
// Tranform and redisplay value
oGet:buffer:=TRANSFORM(xVal,oGet:picture)
oGet:display()
oGet:changed := .T. // Get has changed
ENDIF
// Restore cusor shape and location
DEVPOS(nRow,nCol)
SETCURSOR(nSaveCur)
ENDIF
RETURN (NIL)
*
// Group Extended Gets - DROPBOXL GETS
// Note : Here are some very simples
// CA-CLIPPER generics functions to extend
// GET/READ capability
/***
*
* DropGetReader() Special reader for dropbox gets
* DropGetApplyKey() Dropbox Get apply key
* DropButton() Define a button to allow drop action on a get
* xGetDropBox() Action to be executed when dropbox button is down
*
* xDropBoxBrowse() Browse on a mono dim array (equiv to aChoice())
* nDropBoxSkipper() Skip inside a browse array
* DropBrowseVert() Manage vertical scrollbar percentage
*
*/
*
FUNCTION DropGetReader(oGet ,; // Object to be read
aGetList ,; // Related gets objects
aCtrlButtons ,; // Related buttons
aDropValues ,; // Values available in the drop box
bDropSpecial ; // Block to allow special DropBoxes
)
// Special reader for drop box Get
// Needs some variables to manage Mouse and buttons
LOCAL nKey
LOCAL nCurrentGet
// Record reference of current get in GetList
nCurrentGet := Ascan(aGetList, {|o| o==oGet })
// If needed, reach the requested get
IF !(nHitGet()==NIL) .AND. nCurrentGet<>nHitGet()
IF nCurrentGet > nHitGet()
oGet:exitstate := GE_UP
ELSE
oGet:exitstate := GE_DOWN
ENDIF
ELSE
// Reset GetGoTo Set/Get function
nHitGet(NIL)
// Read the GET if the WHEN condition is satisfied
IF ( GetPreValidate( oGet ) )
// Activate the GET for reading
oGet:setFocus()
WHILE ( oGet:exitState == GE_NOEXIT )
// Check for initial typeout (no editable positions)
IF ( oGet:typeOut )
oGet:exitState := GE_ENTER
ENDIF
// Apply keystrokes until exit
WHILE ( oGet:exitState == GE_NOEXIT )
nKey := mInkey( 0 ,aCtrlButtons ,aGetList )
IF nKey == K_BUTTON .OR. nKey == K_ACCELERATOR
// Nothing To do
ELSEIF nKey == K_GET
IF nCurrentGet > nHitGet()
// Get field clicked is up
oGet:exitState := GE_UP
ELSEIF nCurrentGet < nHitGet()
// Get field clicked is down
oGet:exitState := GE_DOWN
ENDIF
ELSE
// Apply the key to the get object
DropGetApplyKey( oGet, nKey, aDropValues, bDropSpecial )
ENDIF
ENDDO
// Disallow exit if the VALID condition
// is not satisfied
IF ( !GetPostValidate( oGet ) )
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
oGet:killFocus() // De-activate the GET
ENDIF
ENDIF
RETURN (NIL)
*
FUNCTION DropGetApplyKey(oGet ,; // Get object
nKey ,; // Key to be applied
aDropValues ,; // Values available in drop box
bDropSpecial ; // It is a classical autodropbox
)
// Dropbox apply key
DO CASE
CASE nKey == K_ENTER // Enter ==> DropBox
IF bDropSpecial==NIL
xGetDropBox(0, 0, NIL, aDropValues, oGet )
ELSE
xDropSpecial(0, 0, NIL, oGet, bDropSpecial)
ENDIF
OTHERWISE
// For all other key, use standard GetApplyKey()
GetApplyKey(oGet,nKey)
ENDCASE
RETURN (NIL)
*
FUNCTION DropButton(oGet ,; // Get linked to the incremental button
aWinButtons ,; // List of related buttons
aGetList ,; // List of related gets
bDropBox ;
)
// Add a button to manage drop box action
@ FONT_SIZE_X * COL() ,;
FONT_SIZE_Y * ROW() ,,;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION bDropBox ;
DISPLAYUP aBmpBase[DROPBOX_UP] ;
DISPLAYDN aBmpBase[DROPBOX_DW] ;
CARGO oGet ;
ATTACH aWinButtons
RETURN (NIL)
*
FUNCTION xDropSpecial(nMouseX ,; // Mouse location
nMouseY ,; //
aButton ,; // Button reference
oGet ,; // Get object
bDropSpecial ; // Special drop box block
)
LOCAL nRow := 0 // Define some environnement variables
LOCAL nCol := 0
LOCAL nSaveCur := 0
LOCAL xOldVal := 0 // Previous value to restore if needed
LOCAL xVal := 0 // Value to be incremented
IF oGet == NIL
oGet := aButton[BUTTON_CARGO]
ENDIF
// Allow modifications only when when clause,
// if exists, is .T.
IF ( oGet:preBlock == NIL ) .OR. EVAL( oGet:preBlock, oGet )
nRow := ROW() // Save cursor shape and location
nCol := COL()
nSaveCur := SETCURSOR(0)
// If get is focused
IF oGet:hasfocus
// Work on the buffer
xOldVal := oGet:UnTransform()
ELSE
// Else work on the variable
xOldVal := oGet:varget()
ENDIF
xVal := xOldVal // Store for futur value
// Eval special block to retrieve value
xVal := EVAL(bDropSpecial,oGet:row,oGet:col,oGet:row,oGet:row,xVal)
IF xVal <> NIL // Something selected
// Store the new value in the variable
oGet:varput(xVal)
// Set variable value if valid clause, when
// exist, is .T.
IF !( oGet:postBlock == NIL ) .AND. !EVAL( oGet:postBlock, oGet )
// Valid clause is .F., restore old value
oGet:varput(xOldVal)
ELSE
// Tranform and redisplay value
oGet:buffer:=TRANSFORM(xVal,oGet:picture)
oGet:display()
oGet:changed := .T. // Get has changed
ENDIF
ENDIF
// Restore cusor shape and location
DEVPOS(nRow,nCol)
SETCURSOR(nSaveCur)
ENDIF
RETURN (NIL)
*
FUNCTION xGetDropBox(nMouseX ,; //
nMouseY ,;
aButton ,;
aDropValues ,;
oGet ;
)
LOCAL nRow := 0 // Define some environnement variables
LOCAL nCol := 0
LOCAL nSaveCur := 0
LOCAL xOldVal := 0 // Previous value to restore if needed
LOCAL xVal := 0 // Value to be incremented
LOCAL nTop := 0
LOCAL nRight := 0
IF oGet == NIL
oGet := aButton[BUTTON_CARGO]
ENDIF
// Allow modifications only when when clause,
// if exists, is .T.
IF ( oGet:preBlock == NIL ) .OR. EVAL( oGet:preBlock, oGet )
nRow := ROW() // Save cursor shape and location
nCol := COL()
nSaveCur := SETCURSOR(0)
// If get is focused
IF oGet:hasfocus
// Work on the buffer
xOldVal := oGet:UnTransform()
ELSE
// Elsse work on the variable
xOldVal := oGet:varget()
ENDIF
xVal := xOldVal // Store for futur value
// Set the row just under the get row
nTop := oGet:row + 1
// Align Box and drop down button on the right
nRight := oGet:Col+Len(Transform(oGet:Varget(),oGet:picture))+1
xVal := xDropBoxBrowse(nTop,NIL,NIL,nRight,aDropValues,xVal)
IF xVal <> NIL // Something selected
// Store the new value in the variable
oGet:varput(xVal)
// Set variable value if valid clause, when
// exist, is .T.
IF !( oGet:postBlock == NIL ) .AND. !EVAL( oGet:postBlock, oGet )
// Valid clause is .F., restore old value
oGet:varput(xOldVal)
ELSE
// Tranform and redisplay value
oGet:buffer:=TRANSFORM(xVal,oGet:picture)
oGet:display()
oGet:changed := .T. // Get has changed
ENDIF
ENDIF
// Restore cusor shape and location
DEVPOS(nRow,nCol)
SETCURSOR(nSaveCur)
ENDIF
RETURN (NIL)
*
FUNCTION xDropBoxBrowse(nTop ,; // Coordinates in rows and columns
nLeft ,;
nBottom ,;
nRight ,;
aValues ,; // List of caracters values
xInitValue ; // Initial value
)
// Browse on a mono dim array (equiv to aChoice())
LOCAL xSaveScreen := NIL
LOCAL cSaveColor := SETCOLOR("N/W+,W+/N")
LOCAL nSaveCursor := SETCURSOR(0)
LOCAL nSaveRow := ROW()
LOCAL nSaveCol := COL()
LOCAL oBrowse // The TBrowse object
LOCAL nKey := 0 // Keystroke
LOCAL nI := 0 // Indice
LOCAL nJ := 0 // Indice
LOCAL lMore := .T. // Loop control
LOCAL lSelected := .F. // Something selected
LOCAL lNeedVertBar:= .F. // Do we need a vertical Scrollbar
LOCAL nColWidth := 0 // Column width
LOCAL aWinButtons := {} // Arrays to handle buttons
LOCAL aVertScroll := {} // and scrolls bars
// We need to determine best location
IF nLeft == NIL .AND. nBottom == NIL
nBottom := MIN(nTop+LEN(aValues)+1,gMode()[LLG_MODE_TEXT_ROW] - 1)
IF nBottom - nTop < 5 // Not enought lines to fit downward, fit upward
nBottom := nTop - 2
nTop := 0
ENDIF
// Do we need a vertical scrollbar
lNeedVertBar := ( (nBottom-1) - (nTop+1) + 1 ) < LEN(aValues)
AEVAL(aValues,{ |el| nColWidth := MAX(nColWidth,LEN(el)) } )
nLeft := nRight - 2 - IF(lNeedVertBar,2,0) - nColWidth - 2 + 1
ELSE
// Do we need a vertical scrollbar
lNeedVertBar := ( (nBottom-1) - (nTop+1) + 1 ) < LEN(aValues)
ENDIF
// Save screen
xSaveScreen := SAVESCREEN(nTop, nLeft, nBottom, nRight)
// Display 3D box
DISPBOX(nTop,nLeft,nBottom,nRight,LLG_BOX_GRAY_SQUARE)
// Compute the column width
nColWidth := ( nRight - IF(lNeedVertBar,4,2) ) - ( nLeft + 2 ) + 1
// Create a new browse object
oBrowse := TBrowseNew( nTop+1, nLeft+2, nBottom-1, nRight-IF(lNeedVertBar,4,2) )
// Use cargo to store pointer on aValues and
// nRowPtr (equivalent to the RECNO())
oBrowse:cargo := { aValues , 1 }
// Use some translate to make it clearer
#XTRANSLATE :aValues => :cargo\[1\]
#XTRANSLATE :nRowPtr => :cargo\[2\]
// Compute the column width
nColWidth := ( nRight - IF(lNeedVertBar,4,2) ) - ( nLeft + 2 ) + 1
// Add the column to the browse
oBrowse:addColumn( TBColumnNew('',{ || PADR(aValues[oBrowse:nRowPtr],nColWidth) } ) )
// Use a custom 'skipper' to handle arrays moves
oBrowse:skipBlock := { |x| nDropBoxSkipper( x, oBrowse ) }
// Change the heading and column separators
oBrowse:headSep := ''
oBrowse:colSep := ''
IF lNeedVertBar // If we need a vertical scroll bar
// Add vertical scroll bar
@ (nRight-3)*FONT_SIZE_X ,;
(nTop+1)*FONT_SIZE_Y ,;
(nRight-1)*FONT_SIZE_X ,;
nBottom*FONT_SIZE_Y ;
SCROLLBAR ;
STYLE BUTTON_TYPE_SCROLL_VERT ;
ACTIONUP { || oBrowse:stabilize() } ;
ACTIONDN { || oBrowse:stabilize() } ;
ACTIONBAR { |nSens,nPercent| DropBrowseVert(nSens,nPercent,oBrowse)} ;
HANDLE aVertScroll ;
ATTACH aWinButtons
ENDIF
// Add a large button size equal
// to browse size to handle clics
// inside the browse.
// Nothing to draw inside the button !!
@ (nLeft+2 )*FONT_SIZE_X ,;
(nTop+1 )*FONT_SIZE_Y ,;
(nRight-IF(lNeedVertBar,3,1))*FONT_SIZE_X ,;
nBottom*FONT_SIZE_Y ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { |nMouseX,nMouseY| BrowseClic(nMouseX,nMouseY,oBrowse,0),lSelected := .T., lMore := .F. } ;
ATTACH aWinButtons
// Add a close window button
@ nLeft*FONT_SIZE_X ,;
nTop *FONT_SIZE_Y ,,;
BUTTON ;
STYLE BUTTON_TYPE_KEY ;
ACTION K_ESC ;
DISPLAYUP aBmpBase[CLOSWIN_UP] ;
DISPLAYDN aBmpBase[CLOSWIN_DW] ;
ATTACH aWinButtons
// Show all buttons defined
SHOW ALL BUTTONS aWinButtons
// Find initial position
IF (nJ := ASCAN(aValues,xInitValues))==0
nJ := 1
ENDIF
// Go to initial position
IF lNeedVertBar
oBrowse:nRowPtr := nJ
ELSE
FOR nI := 1 TO nJ-1
oBrowse:down()
NEXT nI
ENDIF
// Main loop
WHILE lMore
// Don't let the cursor move into frozen columns
IF ( oBrowse:colPos <= oBrowse:freeze )
oBrowse:colPos := ( oBrowse:freeze + 1 )
ENDIF
// Stabilize the display until it's stable or until a key is pressed
DO WHILE !oBrowse:Stabilize() .AND. NEXTKEY()==0
ENDDO
IF ( oBrowse:hitTop .or. oBrowse:hitBottom )
TONE( 125, 0 )
ENDIF
IF lNeedVertBar .AND. NEXTKEY()==0
// When the browse move, with up(),left()...
// methods, we need to refresh scrollbars
// locations. Refresh only if no key pending
ScrBarUpDate(aVertScroll,DropBrowseVert(NIL,NIL,oBrowse))
ENDIF
// Everything's done -- just wait for a key
nKey := mInkey( 0 , aWinButtons )
IF ( nKey == K_ESC ) // Esc means leave
lMore := .F.
ELSEIF ( nKey == K_BUTTON ) .OR. ;
( nKey == K_CLIC_OUT ) .OR. ;
( nKey == K_ACCELERATOR )
// Warning, when a button is hitted, mInkey() give the hand
// back to main calling routine, and a value of K_BUTTON is
// returned. We must not apply this K_BUTTON to applyKey
// K_CLIC_OUT is returned when the clic does not match
// any button. K_ACCELERATOR is returned when an accelerator
// key have been striked
// We dont need to apply these keys
ELSE
DO CASE
CASE nKey == K_DOWN
oBrowse:down()
CASE nKey == K_PGDN
oBrowse:pageDown()
CASE nKey == K_CTRL_PGDN
oBrowse:goBottom()
CASE nKey == K_UP
oBrowse:up()
CASE nKey == K_PGUP
oBrowse:pageUp()
CASE nKey == K_CTRL_PGUP
oBrowse:goTop()
CASE nKey == K_RETURN
// Something selected
lSelected := .T.
lMore := .F.
ENDCASE
ENDIF
ENDDO
DEVPOS(nSaveRow,nSaveCol)
SETCURSOR(nSaveCursor)
SETCOLOR(cSaveColor)
RESTSCREEN(nTop, nLeft, nBottom, nRight,xSaveScreen)
RETURN (IF(lSelected,oBrowse:aValues[oBrowse:nRowPtr],NIL))
*
STATIC FUNCTION nDropBoxSkipper(nSkip ,; // Number of lines to skip
oBrowse ; // Browse object
)
// Skip inside a browse array
LOCAL nI := 0
DO CASE
CASE ( nSkip > 0 .AND. !(oBrowse:nRowPtr==LEN(oBrowse:aValues)) )
WHILE ( nI < nSkip )
// Skip Foward
oBrowse:nRowPtr := oBrowse:nRowPtr + 1
nI++
IF (oBrowse:nRowPtr==LEN(oBrowse:aValues))
// End of array
EXIT
ENDIF
ENDDO
CASE ( nSkip < 0 .AND. !(oBrowse:nRowPtr==1) )
WHILE ( nI > nSkip )
// Skip backward
oBrowse:nRowPtr := oBrowse:nRowPtr - 1
nI--
IF oBrowse:nRowPtr == 1
EXIT // Begin of array
ENDIF
ENDDO
ENDCASE
RETURN (nI)
*
STATIC FUNCTION DropBrowseVert(nSens ,; // NIL, -1, 0, 1
nPercent ,; // NIL or 0 to 1
oBrowse ; // Browse pointer
)
// Manage vertical scrollbar percentage
IF nSens <> NIL // Move the pointer
IF nSens == 0 // Set the position depending on %
oBrowse:nRowPtr := MAX(1,INT(nPercent*LEN(oBrowse:aValues)))
oBrowse:refreshAll()
ELSEIF nSens == -1 // Move up
oBrowse:up()
ELSEIF nSens == 1 // Move down
oBrowse:down()
ENDIF
ELSE // nSens==NIL just mean : what is location in %
ENDIF
// Return location in %
RETURN (oBrowse:nRowPtr/LEN(oBrowse:aValues))
*
// Group Extended Gets - RADIOS GETS
// Note : Here are some very simples
// CA-CLIPPER generics functions to extend
// GET/READ capability
/***
*
* RadioAddGets() Add gets corresponding to one radio get
* RadioDisplay() Display all gets corresponding to one radio get
* RadioReader() Special reader for radio Get
* RadioApplyKey() Radio Get apply keys
* RadButDisp() Display special buttons for radio gets
* RadOnOff() Switch radio button state
* bLocalDetach() Create detached local variables
* GetBox() Draw a 3D box arround gets
*
*/
*
FUNCTION RadioAddGets(bSetGetVar ,; // Set Get block on master variable
cVar ,; // Variable name
aRadio ,; // List of values
aGetList ,; // Related gets
aCtrlButtons ,; // Related buttons
lHorizontal ,; // Display in horizontal | vertical
lEmptyAllowed ; // Allow an empty choice
)
// Add gets corresponding to one radio get
LOCAL oGet // Temporary get object
LOCAL nGet := 0 // Loop indice
// Number of radio buttons to create
LOCAL nRadioGets := LEN(aRadio)
// First radio button reference in GetList
LOCAL nRadioFirst := LEN(aGetList) + 1
// Cursor location
LOCAL nRow := ROW()
LOCAL nCol := COL()
FOR nGet := 1 TO nRadioGets
// Loop on all choices availables
// Create a new empty GET object
oGet := GETNEW()
// Add it to the Get List
AADD(aGetList,oGet)
// Set the variable name
oGet:name := cVar
// Create a Get block using a detached local
// variable. (Because we are in a loop and nGet
// will take the value nRadioGets+1 when we will
// exit ! )
oGet:block := bLocalDetach(aRadio[nGet])
// We will store 3 elements in the GET cargo
// The real SetGet block , Pointers on the
// others GETS and the logical value for
// allowed empty results
oGet:cargo := { bSetGetVar , ARRAY(nRadioGets) , lEmptyAllowed }
// Use some translate to make it clearer
#XTRANSLATE :bSetGetVar => :cargo\[1\]
#XTRANSLATE :aRadioGets => :cargo\[2\]
#XTRANSLATE :lEmptyAllowed => :cargo\[3\]
// The second GET cargo element must be filled
// with associated GETS references
AEVAL(oGet:aRadioGets , { |el,i| oGet:aRadioGets[i] := nRadioFirst + i - 1 } )
IF lHorizontal // If it is an horizontal radio group
// Set the get location
oGet:col := nCol + 2
oGet:row := nRow
// Go right depending on the len of each get
nCol += 2 + Len(Transform(oGet:Varget(),oGet:picture)) + 1
ELSE // It is a vertical radio group
// Set the get location
oGet:col := nCol + 2
oGet:row := nRow++
ENDIF
// Set the reader to the RadioReader
oGet:reader := { |oG,GetList,aButtons| RadioReader(oG,GetList,aButtons) }
oGet:display()
// Add a button to manage radio
@ FONT_SIZE_X * (oGet:col - 2 ) ,;
FONT_SIZE_Y * oGet:row ,;
FONT_SIZE_X * oGet:col - 1 ,;
FONT_SIZE_Y * ( oGet:row + 1 ) - 1 ;
BUTTON ;
STYLE BUTTON_TYPE_RELEASE ;
ACTION { |x,y,aButton| RadOnOff(x,y,aButton,aGetList) } ;
DISPLAYUP { |nL,nT,nR,nB,xCargo| RadButDisp(nL,nT,nR,nB,xCargo,.T.,aGetList) } ;
DISPLAYDN { |nL,nT,nR,nB,xCargo| RadButDisp(nL,nT,nR,nB,xCargo,.F.,aGetList) } ;
CARGO LEN(aGetList) ;
ATTACH aCtrlButtons
NEXT nGet
RETURN (oGet)
*
FUNCTION RadioDisplay(oGet ,; // Get linked to the radio button
aGetList ; // List of related buttons
)
// Display all gets corresponding to one radio get
LOCAL oGetTmp // Temporary get object
LOCAL nGet := 0 // Loop indice
// Number of radio buttons to manage
LOCAL nRadioGets := LEN(oGet:aRadioGets)
FOR nGet := 1 TO nRadioGets
// Loop on all choices availables
// Retrieve pointers on each get object
oGetTmp := aGetList[oGet:aRadioGets[nGet]]
// Redisplay button in upper position
RadButDisp(FONT_SIZE_X * (oGetTmp:col - 2 ) ,;
FONT_SIZE_Y * oGetTmp:row ,;
NIL ,;
NIL ,;
oGet:aRadioGets[nGet] ,;
.T. ,;
aGetList ;
)
NEXT nGet
RETURN (NIL)
*
FUNCTION RadioReader(oGet ,; // Get linked to the radio button
aGetList ,; // List of related buttons
aCtrlButtons ; // List of related gets
)
// Needs some variables to manage Mouse and buttons
LOCAL nKey := 0
LOCAL nCurrentGet := 0
// Record reference of current get in GetList
nCurrentGet := Ascan(aGetList, {|o| o==oGet })
// If needed, reach the requested get
IF !(nHitGet()==NIL) .AND. nCurrentGet<>nHitGet()
IF nCurrentGet > nHitGet()
oGet:exitstate := GE_UP
ELSE
oGet:exitstate := GE_DOWN
ENDIF
ELSE
// Reset GetGoTo Set/Get function
nHitGet(NIL)
// Read the GET if the WHEN condition is satisfied
IF ( GetPreValidate( oGet ) )
// Activate the GET for reading
oGet:setFocus()
WHILE ( oGet:exitState == GE_NOEXIT )
// Check for initial typeout
// (no editable positions)
IF ( oGet:typeOut )
oGet:exitState := GE_ENTER
ENDIF
// Apply keystrokes until exit
// Replace all the DO WHILE/ENDDO original loop
WHILE ( oGet:exitState == GE_NOEXIT )
nKey := mInkey( 0 ,aCtrlButtons ,aGetList )
IF nKey == K_BUTTON .OR. nKey == K_ACCELERATOR
// Nothing To do
ELSEIF nKey == K_GET
IF nCurrentGet > nHitGet()
// Get field clicked is up
oGet:exitState := GE_UP
ELSEIF nCurrentGet < nHitGet()
// Get field clicked is down
oGet:exitState := GE_DOWN
ENDIF
ELSE
// Apply the key to the get object
RadioApplyKey( oGet, nKey, aGetList )
ENDIF
ENDDO
// Disallow exit if the VALID condition
// is not satisfied
IF ( !GetPostValidate( oGet ) )
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
oGet:killFocus() // De-activate the GET
ENDIF
ENDIF
RETURN (NIL)
*
FUNCTION RadioApplyKey(oGet, nKey, aGetList)
LOCAL bKeyBlock
// Check for SET KEY first
IF ( (bKeyBlock := SetKey(nKey)) <> NIL )
GetDoSetKey(bKeyBlock, oGet)
RETURN(NIL)
ENDIF
DO CASE
CASE ( nKey == K_UP )
oGet:exitState := GE_UP
CASE ( nKey == K_SH_TAB )
oGet:exitState := GE_UP
CASE ( nKey == K_DOWN )
oGet:exitState := GE_DOWN
CASE ( nKey == K_TAB )
oGet:exitState := GE_DOWN
CASE ( nKey == K_ENTER )
oGet:exitState := GE_ENTER
CASE ( nKey == 32 ) // use space bar to toggle the radio button
IF EVAL(oGet:bSetGetVar) == oGet:varget()
// If this get is the selected one
IF oGet:lEmptyAllowed
// If it is allowed to reset all values
// deselect it
EVAL(oGet:bSetGetVar,'')
ENDIF
ELSE // if this get is not selected, select it
EVAL(oGet:bSetGetVar,oGet:varget())
ENDIF
// Redisplay all RADIO GETS
RadioDisplay( oGet , aGetList )
CASE ( nKey == K_ESC )
IF ( SET(_SET_ESCAPE) )
oGet:undo()
oGet:exitState := GE_ESCAPE
ENDIF
CASE ( nKey == K_PGUP )
oGet:exitState := GE_WRITE
CASE ( nKey == K_PGDN )
oGet:exitState := GE_WRITE
CASE ( nKey == K_CTRL_HOME )
oGet:exitState := GE_TOP
CASE (nKey == K_CTRL_W)
oGet:exitState := GE_WRITE
CASE (nKey == K_INS)
SET( _SET_INSERT, !SET(_SET_INSERT) )
ShowScoreboard()
ENDCASE
RETURN (NIL)
*
FUNCTION RadButDisp(nLeft ,; // Buttons pixels coordinates
nTop ,; //
nRight ,; //
nBottom ,; //
nGet ,; // Reference ofthe get in the GetList
lDisplayUp ,; // Display in up or down position
aGetList ; // List of related Gets
)
IF EVAL(aGetList[nGet]:bSetGetVar)==aGetList[nGet]:varget()
// If it is the selected get
gBmpDisp(IF(lDisplayUp,aBmpBase[RADIO_F_UP],aBmpBase[RADIO_F_DW]),;
nLeft ,;
nTop ;
)
ELSE // If it is not the selected get
gBmpDisp(IF(lDisplayUp,aBmpBase[RADIO_E_UP],aBmpBase[RADIO_E_DW]),;
nLeft ,;
nTop ;
)
ENDIF
RETURN (NIL)
*
FUNCTION RadOnOff(nMouseX ,; // Mouse pixels locations
nMouseY ,; //
aButton ,; // Pointer on the button
aGetList ; // List of related get
)
// Switch radio button state
// Retrieve the get object using button cargo
// which contains the number of the get in the
// list
LOCAL oGet := aGetList[aButton[BUTTON_CARGO]]
IF EVAL(oGet:bSetGetVar) == oGet:varget()
// If it is the selected get
IF oGet:lEmptyAllowed
// If it is allowed to reset all values
// deselect it
EVAL(oGet:bSetGetVar,'')
ENDIF
ELSE // If it is deselected, select
EVAL(oGet:bSetGetVar,oGet:varget())
ENDIF
// Redisplay all RADIO GETS
RadioDisplay( oGet , aGetList )
RETURN (NIL)
*
FUNCTION bLocalDetach(xValue)
// Generic function to create detached locals
RETURN ( { || xValue } )
*
FUNCTION GetBox(nTop ,; // Box row/col coordinates
nLeft ,; //
nBottom ,; //
nRight ,; //
nOffset ,; // Frame offset
cTitle ; // Box title (for a future use)
)
// Draw a 3D box arround Gets
LOCAL nGray := 08
LOCAL nWhite := 15
// Compute pixels coordinates
nLeft := nLeft * FONT_SIZE_X - nOffset
nTop := nTop * FONT_SIZE_Y - nOffset
nRight := (nRight + 1 ) * FONT_SIZE_X + nOffset - 1
nBottom := (nBottom + 1 ) * FONT_SIZE_Y + nOffset - 1
// Draw lines
gLine(nLeft ,;
nTop ,;
nRight ,;
nTop ,;
nGray ,;
LLG_MODE_SET ;
)
gLine(nLeft ,;
nTop ,;
nLeft ,;
nBottom ,;
nGray ,;
LLG_MODE_SET ;
)
gLine(nLeft + 1 ,;
nTop + 1 ,;
nRight - 1 ,;
nTop + 1 ,;
nWhite ,;
LLG_MODE_SET ;
)
gLine(nLeft + 1 ,;
nTop + 1 ,;
nLeft + 1 ,;
nBottom - 1 ,;
nWhite ,;
LLG_MODE_SET ;
)
gLine(nRight ,;
nTop + 1 ,;
nRight ,;
nBottom ,;
nWhite ,;
LLG_MODE_SET ;
)
gLine(nRight ,;
nBottom ,;
nLeft + 1 ,;
nBottom ,;
nWhite ,;
LLG_MODE_SET ;
)
gLine(nRight - 1 ,;
nTop + 2 ,;
nRight - 1 ,;
nBottom - 1 ,;
nGray ,;
LLG_MODE_SET ;
)
gLine(nRight - 1 ,;
nBottom - 1 ,;
nLeft + 2 ,;
nBottom - 1 ,;
nGray ,;
LLG_MODE_SET ;
)
RETURN (NIL)
